`8NNNNܻp NNNuTHIS DISK HAS BEEN IMMUNIZED AGAINST MOST VIRUSES BY THE 'ULTIMATE VIRUS KILLER' VERSION 6.0 BY RICHARD KARSMAKERS, *THE* ATARI VIRUS KILLER!!!puke'(*** 3` OoOo;?A C@E`GIKM/S@U`Y[]a gimq s@oy}/@ ` @ ` @ ` @ ` ǀ @ ` ׀ ٠  ` @`!Oa  !Aa!!#A')+-/1!3A5a79;=?A!CAEaGIKMOQ!SAUaWY[]_a!cAeagikmoq!sAuawy{}!Aaa!Aa!Aa!Aaǁɡ!Aaׁ/aa " B b  !"!B!b!!!!!"!""#B"%b"'")"+"-"/#1"#3B#5b#7#9#;#=#?$A"$CB$Eb$G$K$M$O%Q"%SB%Ub%W%Y%[%]%_&a"&cB&eb&g&i&k&m&o'q"'sB'ub'w'y'''B(b((((()")B)b))))` OoOo;?A C@E`GIKM/S@U`Y[]a gimq s@oy}/@ ` @ ` @ ` @ ` ǀ @ ` ׀ ٠  ` @`!Oa  !Aa!!#A')+-/1!3A5a79;=?A!CAEaGIKMOQ!SAUaWY[]_a!cAeagikmoq!sAuawy{}!Aaa!Aa!Aa!Aaǁɡ!Aaׁ/aa " B b  !"!B!b!!!!!"!""#B"%b"'")"+"-"/#1"#3B#5b#7#9#;#=#?$A"$CB$Eb$G$K$M$O%Q"%SB%Ub%W%Y%[%]%_&a"&cB&eb&g&i&k&m&o'q"'sB'ub'w'y'''B(b((((()")B)b))))ASSEMBLY NNAUTO NNC NNGFA  ON MISC (ONPASCAL 6ONSTOS EONDESKTOP INF ICTARI TXT NNbREAD_ME TXT MqW ICTARI 019. NN.. FALCON NNJOY_TEST NNzWAIT_BAR NN. NN.. NNDOC TXT ]YMa1EXAMPLE NNFV NNROUTS NN8CREDITS TXT RMwREAD_ME TXT RMx  Devpac Falcon Library Manual Following are short descriptions of all included routines. Most are subroutines and should be called with 'bsr' or 'jsr' unless the word macro follows the routine name in which case it is a macro. If a routine says 'destroys a lot' then you should save all the registers you are using except a7 which is never ruined. Some routine descriptions even contains an example, so hopefully there will be no problems understanding them. * * CACHE.S * * Cache equates. You'll need devpac 3 for this one I think. * Here they are: * * ENABLE_CACHE EQU 1 ; Enable instruction cache * FREEZE_CACHE EQU 2 ; Freeze instruction cache * CLEAR_INST_CACHE_ENTRY EQU 4 ; Clear instruction cache entry * CLEAR_INST_CACHE EQU 8 ; Clear instruction cache * INST_BURST_ENABLE EQU 16 ; Instruction burst enable * ENABLE_DATA_CACHE EQU 256 ; Enable data cache * FREEZE_DATA_CACHE EQU 512 ; Freeze data cache * CLEAR_DATA_CACHE_ENTRY EQU 1024 ; Clear data cache entry * CLEAR_DATA_CACHE EQU 2048 ; Clear data cache * DATA_BURST_ENABLE EQU 4096 ; Instruction burst enable * WRITE_ALLOCATE EQU 8192 ; Write allocate * * ex. move.l #ENABLE_CACHE+ENABLE_DATA_CACHE+WRITE_ALLOCATE,d0 * movec d0,CACR ; turns on the caches * * * CLS.S * * @cls??? * clears ??? bytes. * In a0.l=start address * (destroys a lot) * * ??? supported: 184320 (384*240*16bp) * 92160 (384*240*8bp) * 32000 (st modes) * ex. bsr @cls92160 * * * CONVPAL1.S * * @convert_stpal * * Convert an old st colour value to a new falcon one * * In d0.w=old st colour * Out d0.l=falcon colour * (destroys d1-d3) * * * COOKIE.S * * @getcookie * * Finds and returns a Cookie. Supervisor only! * * In d1.l=Cookie name * Out d0.l=Cookie value or -1 * (destroys a0) * * * DSPMOD.S * * @dsp_play * * Sets interupts and plays some soundtracker music. Modules * mustn't have more than 4 voices. Supervisor only. * * In a0.l=Module adr. * (destroys a lot) * * @dsp_stop * * Stops playing the music and restores interupts. * Supervisor only. * (destroys a lot) * * * EXIT.S * * @exitifspace macro * branches to exit if space has been pressed. Supervisor only! * (destroys nothing) * * * GEM.S * * @gemdos macro * In #functionnbr, #stackcorrection * ex. @gemdos 1,2 ;waits for a key * * @xbios macro * In #functionnbr, #stackcorrection * ex. @xbios 37,2 ;waits for vsync * * @gem macro * In #functionnbr, #trapnbr, #stackcorrection * ex. @gem 1,1,2 ;waits for a key * * * GETPAR.S (include right after releasem.s) * * Gets all parameters sent to the program. * Must be directly after releasem. * * Out a0.l=Address where the parameters are kept * * ex. include releasem.s release unused memory, this is line * No 1 of the program * include getpar.s get adr. where the parameters are kept * move.l a0,paradr save the result * * paradr ds.l 1 * * * GORAUD.S * * @goraud * * Draw a goraud shaded polygon in true colour. * There's no clipping so don't draw too large polygons. * Call @initgoraud once before using this one! * * In a1.l=screenadr * a2.l=adr to colourtable * new_crds=following table: [x,y,i]*nbr_of_points * d6.w=nbr. of points * xres equ horizontal resolution * (destroys a lot) * * The colourtable consists of 32 words, each a true colour value. * word nr 0 is the darkest and word nr 31 the brightest. This is * followed by 16 empty words. * Supplied colours: g_lightred, g_green, g_brown, g_white * new_crds is a table that consist of a pair of coordinates followed * by a brightnes factor. The brightnes factor is a number between 0 * and #$7fff. * * ex. xres equ 384 overscaned lowres screen * bsr @initgoraud call once only * * move.l scradr,a1 screenaddress * move.l #g_red,a2 I want a red poly * moveq #4,d6 four points * bsr @goraud draw it * * new_crds dc.w 10,10,0 a dark point * dc.w 200,20,$7fff a bright point * dc.w 140,140,$7fff/2 * dc.w 25,50,$7fff/4 * * * @initgoraud * This subroutine must be called once before using @goraud. * * * HLINE1.S * * @drawhline1 * * Draws a horizontal line in 8 bitplane mode. Clipping implemented. * This routine only uses the six first bitplanes. * * In a0.l=screenadr d0=xmin d1=xmax * d2.l - d4.l =6 bitplanes * xres equ horizontal screen resolution * (destroys d0-d7/a0-a1) * * ex. move.l screen+xres*50,a0 ypos=50 * move #-34,d0 left xcord * move #67,d1 right xcord * move.l #$0,d2 don't set bitplane 0 or 1 * move.l #$0000ffff,d3 set bitplane 3 * move.l #$ffffffff,d4 set bitplane 4 and 5 * bsr @drawhline1 * * * ICE.S * * @icedecrunch * * Checks if the data is icepacked and possibly unpacks it. * * In a0.l=Data adr. * * * LOADFILE.S * * @loadfile * * Loads a file and possibly unpacks it (ice 2.40). * * In a5.l=adr. to a filename terminated by zero * a6.l=dest. * d7.l=filelength * (destroys a lot) * * * RELEASEM.S * * This routine releases all memory not needed by the program. * Include this rout at the top of your program and the memory * will be relesed properly. * * ex. include releasem.s release unused memory, this is line nr 1 of * the program * * SAVEFILE.S * * @savefile * * Saves data as a file. * * In a5.l=adr. till nollavslutat filnamn * a6.l=source * d7.l=fillngd * (destroys a lot) * * * SETFV.S * * @setfv * Sets the falcon video registers. The data that is * written to the video registers must be a .FV (Falcon Video) * file. Supervisor only. * In a0.l=adr. to Falcon Video data * Out d0.l: 0=no error -1=error, no .FV data * (destroys d0-d2/a0-a2) * * @savefv * Saves the falcon video registers to memory. Supervisor only. * (destroys a0-a1) * * @resorefv * Restores the saved falcon video registers. Supervisor only. * (destroys d0-d2/a0-a2) * * * SETVIDEO.S * * @setvideo * Save and set resolution. * In d7.w=mode * modeequates: vertflag, stmodes, overscan, pal, vga, col80, bps1-16 * (xbios, destroys d0-d2/a0-a2) * ex. move #pal+bps16,d7 * bsr @setvideo * * @restorevideo * Restores the saved resolution. * (xbios, destroys d0-d2/a0-a2) * * @setvadr * Sets the physical and logical screenadress. * In d0.l=screenadr. * (xbios, destroys d0-d2/a0-a2) * * @savevadr * Saves the current screenadr. * (xbios, destroys d0-d2/a0-a2) * * @restorevadr * Restores the saved screenadr. * (xbios, destroys d0-d2/a0-a2) * * * SHRTONES.S * * @super * enter supervisor mode (gemdos($20), destroys d0-d1/a0-a1) * * @user * returns to user mode (gemdos($20), destroys d0-d1/a0-a1) * * @waitvbl * waits for a vertical blank (xbios(#37), destroys d0-d2/a0-a2) * * @waitkey * waits for a keypress, no echo (gemdos(#7), destroys a0) * Out d0.b=ascii value * * @exitifkey * quits if a key has been pressed * (gemdos(#11,#7,#0), destroys a0) * * @quit * terminate process (gemdos(#0)) * * * TIMER.S * * @colour[#value.l] macro * sets backround colour to value. Supervisor only! * (destroys nothing) * * * TRIG.S * * All results are taken from a 1440 entries large lookup table. * * @sin * Returns the sine of an angle. * In d0.w=angle in degrees with six decimal bits (the legal values are * 0-$59ff or 0-359.999 degrees) * Out d1.w=sin(angle), a word with one sign bit and 15 decimal bits. * (destroys d0/a0) * * @cos * Returns the cosine of an angle. * In d0.w=angle in degrees with six decimal bits (the legal values are * 0-$59ff or 0-359.999 degrees) * Out d1.w=sin(angle), a word with one sign bit and 15 decimal bits. * (destroys d0/a0) * * ex. move #180*64,d0 ; make it 180 degrees * bsr @sin ; d1 will now contain 0 * move #180*64,d0 ; d0 is destroyed so we had better enter * ; the value again * bsr @cos ; d1 will now contain -1 ($8000) * * * WINDOW.S * (vdilib.i & aeslib.i must be included at the end of the program) * * @createwindow * * Creates and opens a simple gem window. * The size (xwidth,ywidth) is the workarea of the window. * * In wtype equ %info move full close name * xstart,ystart,xwidth,ywidth,windowname(string terminated by 0) * Out w_handle,ap_id * (destroys a lot) * * @recalcwindow * Recalculates the window size. * (destroys a lot) * * @moveit * Moves the window. May be called at every vm_moved(=28) event. * In a0.l=adr to messagebuffer * (destroys a lot) * * @drawrsrc * Draws the rsrc. * This function doesn't care about clipping, so you should * probably not use it. * In a0.l=adr to rsrc * (destroys a lot) * * @updatersrc * Draws the rsrc. Use this when receiving update events(=20). * This function takes care of all clipping. * In a0.l=adr to rsrc * (destroys a lot) * * @topwindow * Activates the window. May be called at every vm_topped(=21) event. * In a0.l=adr to messagebuffer * (destroys a lot) * * @bottomwindow * Bottoms the window if it's mine. May be called at every * vm_bottomed(=33) event. * In a0.l=adr to messagebuffer * (destroys a lot) * * @button * Returns the object number that was clicked on. This function may * be called at every mousebutton event. * In a0.l=adr. to rsrc * (It automatically takes the x and y coordinates from int_out) * Out d0.w=object that was pressed or -1. * (destroys a lot) * * @loadrsrc * Loads a resource file and creates a window containg the object in * the file. You don't have to call @createwindow if you use * @loadrsrc. * In wtype equ %info move full close name * windowname(string terminated by 0) * a0.l=address to a nul terminated filename * Out a0.l=address to the resource data * (destroys a lot) * * * WINEVENT.S * * @dowindowevents * For the lazy one. This function waits for events and takes care of * everything but the close button or if someone clicked on an object * If one of these events occur the program branches to closeevent * or buttonevent. Those subroutines you have to make yourself. * In a0.l=adr. to rsrc * w_handle, ap_id (These are created automatically if you * use @createwindow) * Out buttonevent: d0.w=number of the object pressed * closeevent: nothing * (destroys a lot) * * ex. ;create a window; * move.l rsrcadr,a0 * bra @dowindowevents ; it will never return so you may use * 'bra' or 'jmp' * * buttonevent ; d0.w will contain the object that was pressed * cmp #1,d0 ; was it my button? * beq mybutton ; yes! * rts ; no! * * closeevent * bsr @exitwindow ; close window * (rsrc_free) ; only if you have used @loadrsrc * bra @quit ; quit * . NN.. NNGEMSTUF RSC |FALCVID S ;t#GEMSTUF4S t#SETVDO S t#\TRUEGEM S u# V:VVV$VVTjosan vilken text$78y$ x : V* * This program will save the current screen mode as a Falcon Video file. * include releasem.s bra main include shrtones.s include savefile.s include gemmacro.i include gem.s filelength equ 44 main fsel_exinput #path,#filen,#title ; fileselector bsr @super lea buffer,a1 move.l #'FVDO',(a1)+ 4 bytes header move.b $ff8006,(a1)+ monitor type move.b $ff820a,(a1)+ sync move.l $ff820e,(a1)+ offset & vwrap move.w $ff8266,(a1)+ spshift move.l #$ff8282,a0 horizontal control registers loop1 move (a0)+,(a1)+ cmp.l #$ff8292,a0 bne loop1 move.l #$ff82a2,a0 vertical control registers loop2 move (a0)+,(a1)+ cmp.l #$ff82ae,a0 bne loop2 move $ff82c2,(a1)+ video control bsr @user moveq #0,d0 move.b path,d0 sub.b #'A',d0 move d0,-(sp) @gemdos $e,4 set drive move.l #path+150,a0 search cmp.b #'\',-(a0) bne search move.b #0,(a0) move.l #path+2,-(sp) @gemdos $3b,6 change dir move.l #filen,a5 move.l #buffer,a6 move.l #filelength,d7 bsr @savefile save it bra @quit path dc.b 'C:\*.FV',0 ds.b 150 title dc.b 'Create a Falcon Video file',0 include aeslib.s section bss even buffer ds.b filelength filen ds.b 50 ********************************************************* * * * A very short window demonstration using a rsrc file * * * ********************************************************* include releasem.s release unused memory include getpar.s find where the parameters sent to the program are move.l a0,parbuf save the address bra main include gemmacro.i this one is supplied with devpac include shrtones.s include window.s include winevent.s include gem.s wtype equ %01011 info, move, full, close and name windowname dc.b 'hello world',0 main move.l #rsrcfile,a0 bsr @loadrsrc move.l a0,rsrcadr bra @dowindowevents this routine will take care of all the common events buttonevent cmp #1,d0 was my button pressed? beq button1 yes! rts button1 form_alert alertbutton,#alerttext rts closeevent bsr @exitwindow rsrc_free bra @quit rsrcfile dc.b 'gemstuf.rsc',0 even alertbutton dc.w 1 alerttext dc.b '[2][You have not saved anything|are you sure you want to quit?][ Yes ]',0 buttontext dc.b 'a button',0 include aeslib.s supplied with devpac include vdilib.s supplied with devpac section bss parbuf ds.l 1 rsrcadr ds.l 1 * * Drop a .FV file on this program. * include releasem.s include getpar.s move.l a0,paradr bra main include shrtones.s include loadfile.s include gem.s include setfv.s main move.l paradr,a5 move.l #buffer,a6 move.l #48,d7 bsr @loadfile bsr @super lea buffer,a0 bsr @setfv cmp.l #-1,d0 beq error bsr @user bra @quit error move.l #errortext,-(sp) @gemdos 9,6 bsr @waitkey bra @quit vbl addq.l #1,$466 rte errortext dc.b 'Not a Falcon Video (.FV) file.',10,13,0 section bss even paradr ds.l 1 buffer ds.w 22 ********************************************************* * * * A window demonstration * * * * Swirling colours in a gem window. * * * ********************************************************* include releasem.s release unused memory include getpar.s find where the parameters are kept move.l a0,parbuf save it bra main include gemmacro.i this one is supplied with devpac include shrtones.s include window.s include gem.s wtype equ %100100101011 sizebox, info, move, full, close and name windowname dc.b 'True Colours',0 main move #-1,-(sp) @xbios $58,4 and #$7,d0 cmp #4,d0 bne not_tc move #32,xstart window start position move #50,ystart move #190,xwidth window size move #80,ywidth bsr @createwindow menu_register ap_id,#applname ; set the name of the application wait evnt_multi #%110010,#1,#1,#1,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#msgbuf,#40 ;get message and button events btst.b #4,int_out+1 bne msgevent msgready btst.b #5,int_out+1 bne timerevent timerready btst.b #1,int_out+1 bne buttonevent bra wait msgevent move msgbuf,d0 cmp #20,d0 is it an update event? beq redraw cmp #22,d0 was the close box pressed? beq exit cmp #27,d0 beq sized cmp #28,d0 was the window moved? beq moved cmp #23,d0 was the full button pressed beq full cmp #21,d0 was the window topped? beq topped cmp #33,d0 was it bottomed? beq bottomed bra msgready it was something unimportant buttonevent bra wait nothing of importance was clicked on timerevent bsr update bra timerready exit bsr @exitwindow bra @quit redraw bsr update bra msgready moved lea msgbuf,a0 bsr @moveit bra msgready sized lea msgbuf,a0 bsr @resizewindow bra msgready bottomed lea msgbuf,a0 bsr @bottomwindow bra msgready topped lea msgbuf,a0 bsr @topwindow bra msgready full bra msgready update wind_update #1 @xbios 3,2 move.l d0,a1 move colour,d0 move d0,d2 swap d0 move d2,d0 move xwidth,d1 lsr #1,d1 add #2,d1 add d1,colour movem.l d0/a1,-(sp) wind_get w_handle,#11 tst.w int_out+6 bne .next tst.w int_out+8 beq .out .next movem.l (sp)+,d0/a1 move.l a1,a0 move int_out+2,d2 bge .notneg add d2,int_out+6 move #0,int_out+2 bra .x2ok .notneg add int_out+6,d2 sub screenxmax,d2 ble .x2ok sub d2,int_out+6 ble .dontdraw .x2ok move int_out+4,d2 add int_out+8,d2 sub screenymax,d2 ble .y2ok sub d2,int_out+8 ble .dontdraw .y2ok move int_out+2,d1 lsl #1,d1 ext.l d1 add.l d1,a0 move int_out+4,d2 move screenxmax,d5 add #1,d5 add d5,d5 mulu d5,d2 add.l d2,a0 move int_out+6,d4 lsr #1,d4 sub #1,d4 move int_out+8,d2 sub #1,d2 move screenxmax,d5 add #1,d5 add d5,d5 move d5,d3 move d4,d1 addq #1,d1 lsl #2,d1 sub d1,d3 bsr newline .dontdraw movem.l d0/a1,-(sp) wind_get w_handle,#12 tst.w int_out+6 bne .next tst.w int_out+8 bne .next .out movem.l (sp)+,d0/a1 wind_update #0 rts newline move d4,d1 dopix move.l d0,(a0)+ add.l #$10001,d0 dbra d1,dopix pixready add.l d3,a0 dbra d2,newline rts not_tc form_alert #1,#alerttext bra @quit colour dc.w $40d3 applname dc.b ' True Colours',0 alerttext dc.b '[1][ True Colour only][oooh]',0 include aeslib.s supplied with devpac include vdilib.s supplied with devpac section bss msgbuf ds.w 20 parbuf ds.l 1 . NN.. NNFALCVID PRG ]RGB0 FV k,RGB1 FV d ,RGB12 FV !,RGB13 FV ",RGB14 FV #,RGB17 FV n$,RGB18 FV v%,RGB19 FV &,RGB2 FV W',RGB22 FV Ͼ(,RGB27 FV ),RGB3 FV 2*,RGB32 FV B+,RGB34 FV X,,RGB37 FV G-,RGB39 FV S.,RGB4 FV B/,RGB7 FV \0,RGB8 FV M1,RGB9 FV Y2,SETVDO PRG 3FVDOC TXT wSM5AFV_FILESTXT IRM7`t*O*m,M - ЭЭ"ҍ.A// Bg?<JNAO `B?< NA\#LNu/9L?< NA\Nu?<%NNTNu?<NATNu?< NATJmNua.NuBgNA?</ ?<NAXNu#~L#P#Tp[aXaVC\"FVDO "2f |2رf |2رf2ap9~A??<NAX | \f/<?<;NA\*|,|\~,a`C:\*.FVCreate a Falcon Video fileC2@ Ap222BQ"<t0<NB09>Nu>LX mainpath~@quit@userPfilenloop1loop2 title@super:buffer\globalint_insearchPaddr_inLcontrolint_out>@waitkeyj@waitvbl`CALL_AES8addr_outX@savefilHe@exitifkHteyaes_paraHtmssavedsp0HL673gem_ctrlH_listF 68P FVDOV0P %FVDOV`>07 4 %FVDOVvqk++kkFVDOVeqk++kkFVDOV wWqk++kkFVDOVP = $FVDOVPM $FVDOVP1a $FVDOVP = %FVDOVPM MFVDOVPMqe/kFVDOVPM %FVDOV`' %FVDOV' %FVDOV`'qe/W7kFVDOV'qe/W7kFVDOVP1a %FVDOVP >qe/W7kFVDOVPNqe/W7kFVDOVP1bqe/W7k`0*O*m,M - ЭЭ"ҍ.A// Bg?<JNAO Hn _#`B?< NA\#XNu/9X?< NA\Nu?<%NNTNu?<NATNu?< NATJmNua.NuBgNANSHIx,La ICE!fnatKan."Npw!Q&N%af*Kad8><adpa>|8#zD@DADBDCQQHQLSfpw#QLN[NurQNua*d"ra$dCv !a"H@@Vҩ%QnNuf%Nurf%AQNuCtaTxr1 Hka1 Ag"CvtaTr1 HaBq jD`rptadpt?aBC@!!Q`R   ?</ ?<=NAP<//??<?NAO ??<>NAX NaJNu FVDOf\T/8p@!pF# 8ffg#3f"|2سf"|2سf3F!ppNupNupNu f` f`RfNsC2"FVDO "2f |2رf |2رf2Nu |2a*Nu*y,|~0aaAaܰg a` /<?< NA\a`RfNsNot a Falcon Video (.FV) file. vblmain^@quit@user\error@setfvX@superFbufferparadr@savefv@waitkeyv@waitvbll@loadfilH&eerrortexHt@exitifkHey@restoreH&fvsavedsp0HX673@icedecrHunchFVbufferH21298@getparaH6metersende_iceH&_decrunch_2> 6pL8 Falcon Video file creator The program called FALCVID.PRG will save the current screen as a Falcon Video file (.FV). You can then easily set this resolution from within your own program. The data are read directly from the video control registers, so this should work with most software screen expanders too. It's only the resolution and frequency that are saved not any picture data. Set video program The program called SETVDO.PRG will change the current video mode if you drop a .FV file on it. Gem will not work properly if this results in a different screen size. Do not use RGB files if you are using a VGA monitor!!! This program may damage your monitor, use it at your own risk. Because of a bug I haven't found, these programs doesn't always work properly with very high resolutions or frequencies, neither can they detect if you are using the correct monitor. I would appreciate I someone could help. Suggestions or questions may be sent to Johan Karlsson (d92jk@efd.lth.se). Falcon Video files RGB0 768*240 pixels 1 bitplane 60 Hz RGB1 768*240 pixels 2 bitplanes 60 Hz RGB2 768*240 pixels 4 bitplanes 60 Hz RGB3 768*240 pixels 8 bitplanes 60 Hz RGB4 768*240 pixels True Colour 60 Hz RGB7 768*240 pixels 4 bitplanes 50 Hz RGB8 768*240 pixels 8 bitplanes 50 Hz RGB9 768*240 pixels True Colour 50 Hz RGB12 800*288 pixels 4 bitplanes 50 Hz RGB13 800*288 pixels 8 bitplanes 50 Hz RGB14 800*288 pixels True Colour 50 Hz RGB17 768*480 pixels 4 bitplanes 60 Hz interlaced RGB18 768*480 pixels 8 bitplanes 60 Hz interlaced RGB19 768*480 pixels True Colour 60 Hz interlaced RGB22 640*200 pixels 4 bitplanes 60 Hz RGB27 640*200 pixels 4 bitplanes 50 Hz RGB32 384*240 pixels 4 bitplanes 60 Hz RGB34 384*240 pixels True Colour 60 Hz RGB37 384*240 pixels 4 bitplanes 50 Hz RGB39 384*240 pixels True Colour 50 Hz . NN8.. NNCACHE S @c 9CLS S Xk :CONVPAL1S zL<COOKIE S V\=DSP BSW l>t-DSPMOD S ˍJEXIT S 'NGEM S Y OGETPAR S LVPGORAUD S É QHLINE1 S 8 WEICE S t_; LOADFILES BZ cRELEASEMS `dSAVEFILES gb ezSETFV S sfSETVIDEOS ,c hSHRTONESS ]jhSINTAB INL @ k@ TIMER S -nTRIG S oWINDOW S s#pQWINEVENTS \u* * CACHE.S * * Cache equates. You'll need devpac 3 for this one, I think. * * ex. move.l #ENABLE_CACHE+ENABLE_DATA_CACHE+WRITE_ALLOCATE,d0 * movec d0,CACR ; turns on the caches * ENABLE_CACHE EQU 1 ; Enable instruction cache FREEZE_CACHE EQU 2 ; Freeze instruction cache CLEAR_INST_CACHE_ENTRY EQU 4 ; Clear instruction cache entry CLEAR_INST_CACHE EQU 8 ; Clear instruction cache INST_BURST_ENABLE EQU 16 ; Instruction burst enable ENABLE_DATA_CACHE EQU 256 ; Enable data cache FREEZE_DATA_CACHE EQU 512 ; Freeze data cache CLEAR_DATA_CACHE_ENTRY EQU 1024 ; Clear data cache entry CLEAR_DATA_CACHE EQU 2048 ; Clear data cache DATA_BURST_ENABLE EQU 4096 ; Instruction burst enable WRITE_ALLOCATE EQU 8192 ; Write allocate * * CLS.S * * @cls??? * clears ??? bytes. * In a0.l=start adress * (destroys everything) * * ??? supported: 184320 (384*240*16bp) * 92160 (384*120*16bp) * 32000 * @cls184320 moveq #0,d1 moveq #0,d2 moveq #0,d3 moveq #0,d4 moveq #0,d5 moveq #0,d6 moveq #0,d7 move.l d1,a1 move.l d1,a2 move.l d1,a3 move.l d1,a4 move.l d1,a5 move.l d1,a6 move #885,d0 add.l #184320,a0 .cl2 movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) dbra d0,.cl2 movem.l d1-d7/a1,-(a0) rts @cls92160 moveq #0,d1 moveq #0,d2 moveq #0,d3 moveq #0,d4 moveq #0,d5 moveq #0,d6 moveq #0,d7 move.l d1,a1 move.l d1,a2 move.l d1,a3 move.l d1,a4 move.l d1,a5 move.l d1,a6 move #442,d0 add.l #92160,a0 .cl2 movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) dbra d0,.cl2 movem.l d1-d4,-(a0) rts @cls32000 moveq #0,d1 moveq #0,d2 moveq #0,d3 moveq #0,d4 moveq #0,d5 moveq #0,d6 moveq #0,d7 move.l d1,a1 move.l d1,a2 move.l d1,a3 move.l d1,a4 move.l d1,a5 move.l d1,a6 move #152,d0 add.l #32000,a0 .cl2 movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) dbra d0,.cl2 movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d7/a1-a6,-(a0) movem.l d1-d5,-(a0) rts * * CONVPAL1.S * * @convert_stpal * * Convert an old st colour value to a new falcon one * * In d0.w=old st colour * Out d0.l=falcon colour * (destroys d1-d3) * @convert_stpal move d0,d1 move d1,d2 and.l #$0007,d0 lsl.l #5,d0 Blue ready and.l #$0070,d1 move #17,d3 lsl.l d3,d1 or.l d1,d0 Green ready and.l #$0700,d2 move #21,d1 lsl.l d1,d2 or.l d2,d0 Green ready rts * * COOKIE.S * * Finds and returns a Cookie. Supervisor only! * * In d1.l=Cookie name * Out d0.l=Cookie value or -1 * (destroys a0) * @getcookie move.l $5a0,a0 move.l a0,d0 beq.s .failed .loop move.l (a0)+,d0 beq.s .failed cmp.l d0,d1 beq.s .success addq.l #4,a0 bra.s .loop .success move.l (a0)+,d0 cmp.b d0,d0 rts .failed moveq #-1,d0 rts `0``h`#DSP-Protracker 3.0 Replay coderight by bITmASTER of BSW of CC 04/11/93 * Steffen Scharfe * Sachsenburgweg 6 * D-99094 Erfurt * based upon Protracker 3.00B by Tom Bech and Ivar J.Olsen H3#J@ga a aaaHy?<&NN\LNuA0# 31|3 Jyf:#A  !!! NuHHy?<&NN\LNuA0 1y1y Jyf&A! !!ȘNuHa LNsAdC`GIKBU|BU0)E:pg0JigBi`"LҀ cf"`"LD҄"pg0Tg>3L*c2>$AaHge >$Ca4`B:gBUNqBU` >$AaBBURyQDa NuB:gOg:QNu yCEpv M.K.8g FLT48g CEpv##3"y$ITprdQ*dB*RAL<"yC*E09$r2ҁJCfQNuAd0<OBQ0<rP$<$fRh(LA@ RQNuAC`0<"#HB#| 3|QNu yRy#0:zeBy#J9#g(a`|a`|MK`a,QNuG yr$y0:r20:dHҀBy#|K`M4ap.;@,RF|fy#9#g #B9#J9#gS9#gy#J9#gQ#p:H3#B9# y#fBp:H3#B9#B9#Ry#y#2: yڲe r(3#J9#fNuJfa0,X9#gt.< <JgvC8B+S-q(=sH=sH(sHsH63Hg8$.Cԃ-B -B$LHB6.(Cc=CC@=B`=@=B`$.-B -B$=sH0|g0.||Pg .<<g<g< fa|`ab`aL`lH2|C p~$qdTQr.J=qL0.||g(.fB..fB.;| .f <V*+@p+@ B =|`"*t4.ԂЂ+@+n p0.Ѐ+@ 0.;@P*0.y#`a p.;@NuaJ0.|gZ.<JgX<gİ<g<g<g.<g°<g°<g;n<g< gNu;nNup0:6H@|g |g4.`>p.` p.<@r.JAr2.~$40PdTQNu;BNuJy#f#p.9##n0.||qj nnq0.|;@NuJy#f<#B@.9##n0.||Xk nnX0.|;@Nu/4|p.JAppd T@|JepF.<gJ@gU@40 _=B0.B.@g l|NuBnNu.g@B.Jng|p.J.fn0.nn$=nBn`n0.nm =nBn4..<g&p.JAppd T@|JepF40;BNu.g$.<g<.<g<B/ .IH|t.<g <g<`J.j<``4.|J0.J.kB`B;@.H|<.(_Nua`a`/ .g$.<g<.<g<B.IH|t. <g <g<`J.j<``4.|Jp.J.kB`BjB@|@c0<@;@.H|<.(_XNup.g@ . Hnl nHѮNu=|Nup.Jg. .@k|@.Nup.<.jB..Nup.S3#B9#P#Nup.<@cp@@Nup.$ <<?b#P#Nu.|g By#3#Nu.<< g< gz< g<g<g< g|`.<gv<g<g:<gl<gz<g<g<gа<gް<g< g< gd< gt< g< g<gNu.<Nu.<..Nu.<..Nu.<@NuJy#f.<g$J."gS."g!#P#Nu@"`09#<?@!Nu.<..NuH` n "H0.@U@H(HABQHHABLNu/p.<gR29#f2|fB29#HHAJAf2;| .*r2.ҁЁ+@;n+n p0.Ѐ+@ "NuJy#fp.<`PJy#fp.<`Zp.<y#fB.Nup.<y#fz0|gp/`^Jy#f`p.<J9#fLR#NuJy#f8.<..JgH@p.g>A0.#.#g*B.# . r2.ЁЁ n$Re n -H$pLNuHAXCBfAJ||@|l|3##LNuHHy?<&NN\LNuA@F'<@<@F 8Tm@F'<@FAC#0<JkVIYYYS@`J@gB(B(B(S@f(gB(B(B(C%x(gYYYJ)k(gYYY`Nu  +@1JaxŴxaJ1X(\:}hS@. xqR"}Y7{eQ>, ~wqLxU3xcO<* }vpFtP/u`L:(}vo@oL+ r^J8&|un: kH'p[H5${tm4fD#mYE3"zsm.b?kVC1 yrlX(\:}hS@. xR"|Y7{eQ>, ~w~LxU3xcO<* }vwFtP/u`L:(}vq@oL+ r^J8&{uk: kH'p[H5${td4fD#mYE3"zs^.b?kVC1 yrPDPP PVPIP DP`P|P"P P P ڄP XP PPP0P P@PXP P|EP P P P|#P`P`P P|EPP|"P P!|EP"XP# P$|EP% P& P'$P( FP)%PEP* P+|@P, P-|EP.%XeP/ P0|4P1`P2 P3|#P4%YeP5 P6|:P7D`P8 P9|#P: eP; P<|#P=L`P> P?|#P@ PA PBPC PD`PE PF|EPGD+PH XXXXXXXXXX X X X X XXXXXXXXXXXXXXXXXXX P P@P P>P@PAPBPCPD&PEPFgPG PHgPI PJPKI_PLPMPN0POPPAPQPRXPSPTPUPVPWPX PYXPZE+P[fP\ P]gP^$P_ P`dPa PbaPcE+Pd p#PePf"Pg"PhDLPiPj PkmPl HPmW Pn`PoPpaPqPr Ps Pt`PuPvaPw Px Py Pz`P{ P|aP}P~ P P`PPaPP P P pPPFPpP'PDP PVP PVPDP PV P PV PDP PVP PVPDP PVP PVP"P `P`PP2P3P P @P`PP2 P3 P P`P P2P3P P`PP2P3P P aPaPPWP!P P PPaPPWP IP!P"4P P PP PP"PWPP IP"$P LPPPDPDYP#P`PPDPEPFPFP!P ZP!PWPpPPP HP PP WPEPFPFP!P P!PHP PP P 0PH^PWRP"PDPP LPWbP PD+PP HPP PDPEPPDPP!/PENPPUYPDPDPP !/P NP UYP P P PYP PPE+PEYP PPPDP P PP+P PP+P P P!O+P"WXP# P$ P%.P&D+P'P( HP)P*-P+ P,+P-XP. P/.P0O+P1WXP2 P3 P4=P5D+P6P7 HP8P9 P?BP@PAPBPCPDDSPPE-PaPFulaPG-EmPHulaPItorPJ V2PK.0 PLcodPMeriPNghtPO byPP bIPQTmAPRSTEPSR oPTf BPUSW PVof PWCC  xR&2.",,,  &2P 2 6$pF" \H* * DSPMOD.S * * @dsp_play * * Sets interupts and plays some music. Supervisor only. * May return to user mode after the procedure. * * In a0.l=Module adr. * (destroys a lot) * * @dsp_stop * * Stops playing the music and resets interupts. * Supervisor only. * ;DSP MOD replay routine written by bITmASTER of BSW ;This is source code for Devpack 3 iera equ $fffffa07 ;Interrupt-Enable-Register A ierb equ $fffffa09 ; B imra equ $fffffa13 isra equ $fffffa0f isrb equ $fffffa11 tacr equ $fffffa19 tbcr equ $fffffa1b tadr equ $fffffa1f tbdr equ $fffffa21 tccr equ $fffffa1d tcdr equ $fffffa23 aer equ $fffffa03 STColor equ $ffff8240 FColor equ $ffff9800 d_vbl equ $70 timer_int equ $0120 timer_c_int equ $0114 ym_select equ $ffff8800 ym_write equ $ffff8802 ym_read equ $ffff8800 vbaselow equ $ffff820d vbasemid equ $ffff8203 vbasehigh equ $ffff8201 vcountlow equ $ffff8209 vcountmid equ $ffff8207 vcounthigh equ $ffff8205 linewid equ $ffff820f hscroll equ $ffff8265 keyctl equ $fffffc00 keybd equ $fffffc02 DspHost equ $ffffa200 HostIntVec equ $03fc PCookies equ $05a0 d_hop equ $ffff8a3a op equ $ffff8a3b line_nr equ $ffff8a3c mode equ $ffff8a3c skew equ $ffff8a3d endmask1 equ $ffff8a28 endmask2 equ $ffff8a2a endmask3 equ $ffff8a2c x_count equ $ffff8a36 y_count equ $ffff8a38 dest_x_inc equ $ffff8a2e dest_y_inc equ $ffff8a30 dest_adr equ $ffff8a32 src_x_inc equ $ffff8a20 src_y_inc equ $ffff8a22 src_adr equ $ffff8a24 mpx_src equ $ffff8930 mpx_dst equ $ffff8932 @dsp_play move.l a0,-(sp) lea player079,a0 bsr reloziere079 move.l (sp)+,a0 moveq #1,d0 bsr player079+28 ;ein bsr init079 rts @dsp_stop bsr off079 bsr player079+28+4 ;aus rts timer_b079: movem.l d0-a6,-(sp) bsr player079+28+8 movem.l (sp)+,d0-a6 bclr #0,$fffffa0f.w rte init079: lea SaveArea079,a0 move.l timer_int.w,(a0)+ move.b tbcr.w,(a0)+ move.b tbdr.w,(a0)+ move.b #246,tbdr.w move.b #7,tbcr.w move.l #timer_b079,timer_int.w bset #0,imra.w bset #0,iera.w rts off079: bclr #0,iera.w bclr #0,imra.w lea SaveArea079,a0 move.l (a0)+,timer_int.w move.b (a0)+,tbcr.w move.b (a0)+,tbdr.w rts reloziere079: move.l 2(a0),d0 ;Relozieren add.l 6(a0),d0 add.l 14(a0),d0 adda.l #$1c,a0 move.l a0,d1 movea.l a0,a1 movea.l a1,a2 adda.l d0,a1 move.l (a1)+,d0 adda.l d0,a2 add.l d1,(a2) clr.l d0 L000A: move.b (a1)+,d0 beq L000C cmp.b #1,d0 beq L000B adda.l d0,a2 add.l d1,(a2) bra L000A L000B: adda.l #$fe,a2 bra L000A L000C: rts player079: incbin 'DSP.BSW' even SaveArea079: ds.b 6 even * * EXIT.S * * @exitifspace macro * branches to exit if space has been pressed * (destroys nothing) * @exitifspace macro cmp.b #$39,$fffffc02.w beq exit endm * * GEM.S * * @gemdos macro * In #functionnbr, #stackcorrection * ex. @gemdos 1,2 ;waits for a key * * @xbios macro * In #functionnbr, #stackcorrection * ex. @xbios 37,2 ;waits for vsync * * @gem macro * In #functionnbr, #trapnbr, #stackcorrection * ex. @gem 1,1,2 ;waits for a key * @gemdos macro move #\1,-(sp) trap #1 add.l #\2,sp endm @xbios macro move #\1,-(sp) trap #14 add.l #\2,sp endm @gem macro move #\1,-(sp) trap #\2 add.l #\3,sp endm * * GETPAR.S (include right after releasem.s) * * Gets all parameters sent to the program. * Must be directly after releasem. * * Out a0.l=address where the parameters are. * @getparameters pea $81(a6) move.l (a7)+,a0 * * GORAUD.S * * @goraud * * Draw a goraud shaded polygon in true colour. * There's no clipping so don't draw too large polygons. * * In a1.l=screenadr * a2.l=adr to colourtable * new_crds=following table: [x,y,i]*nbr_of_points * d6.w=nbr. of points * xres equ horizontal resolution * (destroys a lot) * * The colourtable consists of 32 words, each a true colour value. * word nr 0 is the darkest and word nr 31 the brightest. This is * followed by 16 empty words. * Supplied colours: g_lightred, g_green, g_brown, g_white * new_crds is a table that consist of a pair of coordinates followed * by a brightnes factor. The brightnes factor is a number between 0 * and #$7fff. * * ex. xres equ 384 overscaned lowres screen * bsr @initgoraud call once only * * move.l scradr,a1 screenaddress * move.l #g_red,a2 I want a red poly * moveq #4,d6 four points * bsr @goraud draw it * * new_crds dc.w 10,10,0 a dark point * dc.w 200,20,$7fff a bright point * dc.w 140,140,$7fff/2 * dc.w 25,50,$7fff/4 * * * @initgoraud * This subroutine must be called once before using '@goraud'. * @goraud lea offsets,a0 move.l a1,workscr2354 move.l a2,colouradr2354 bsr GDraw_Poly rts colouradr2354 ds.l 1 offsets dc.w 0,6,12,18,24,30,36,42,48,54,60,66,72,78,84,90,96,100 ;-----------------------------------------------------------------------; ; Gouraud Shaded Polygon Routine. ; ; A0 -> D6 coords (offsets into 'new_crds' in form X,Y,INTENSITY CONST) ; ;-----------------------------------------------------------------------; GDraw_Poly LEA trans_crds,A1 LEA new_crds,A6 MOVE D6,D0 ADD D6,D6 ADD D0,D6 ADD D6,D6 6*d6 MOVE.L A1,A5 ADDA.W D6,A5 MOVE.L A5,A2 ADDA.W D6,A2 Init_coords SUBQ #2,D0 MOVE.W (A0)+,D7 MOVE.W 4(A6,D7),D5 MOVE.L (A6,D7),D7 MOVE D7,D2 MOVE.L A5,A4 MOVE.L D7,(A1)+ ; dup first coord MOVE.W D5,(A1)+ MOVE.L D7,(A2)+ MOVE.W D5,(A2)+ MOVE.L D7,(A5)+ MOVE.W D5,(A5)+ .coord_lp MOVE.W (A0)+,D3 MOVE.W 4(A6,D3),D5 MOVE.L (A6,D3),D3 CMP D2,D3 BGE.S .not_top MOVE D3,D2 MOVE.L A5,A4 .not_top CMP D3,D7 BGE.S .not_bot MOVE D3,D7 .not_bot MOVE.L D3,(A1)+ ; dup for rest MOVE.W D5,(A1)+ MOVE.L D3,(A2)+ MOVE.W D5,(A2)+ MOVE.L D3,(A5)+ MOVE.W D5,(A5)+ DBF D0,.coord_lp MOVE.L A0,USP MOVE.L A4,A5 SUB D2,D7 ;d2 - lowest y d7 - greatest y BEQ polydone MOVE D2,-(SP) MOVE D7,-(SP) CALCS LEA grad_table+640(PC),A0 ; Calc x's down left side of poly Do_left LEA LEFTJMP(PC),A2 LEA x1s(PC),A3 Left_lp SUBQ #6,A4 MOVEM.W (A4),D1-D2 ;x1,y1 MOVEM.W 4(A4),D0/D3-D5 ;I2,x2,y2,I1 SUB D4,D2 ;dy SUB D3,D1 ;dx SUB D2,D7 ;remaining lines-dy SUB D5,D0 ;DI EXT.L D0 DIVS D2,D0 ADD.W D2,D2 MULS (A0,D2),D1 ADD.L D1,D1 MOVE.W D1,D4 ; frac part SWAP D1 ; whole part MOVE.W D2,D6 ADD D2,D2 ADD D2,D2 ADD D6,D2 ; *10 NEG D2 CLR.W D6 JMP (A2,D2) REPT 200 MOVE.W D3,(A3)+ ADD.W D4,D6 ADDX.W D1,D3 MOVE.W D5,(A3)+ ADD.W D0,D5 ENDR LEFTJMP TST D7 BGT Left_lp ; Calc x's down right side of poly Do_right MOVE.W (SP),D7 LEA RIGHTJMP(PC),A2 LEA x2s(PC),A3 Right_lp MOVEM.W (A5)+,D1-D2/D5 ;x1,y1,I2 MOVEM.W (A5),D3-D4/D6 ;x2,y2,I1 SUB D2,D4 ;dy SUB D1,D3 ;dx SUB D4,D7 ;remaining lines-dy SUB D5,D6 ;DI EXT.L D6 DIVS D4,D6 ADD.W D4,D4 MULS (A0,D4),D3 ADD.L D3,D3 MOVE.W D3,D2 ; frac part SWAP D3 ; whole part MOVE.W D4,D0 ADD D4,D4 ADD D4,D4 ADD D0,D4 ; *10 NEG D4 CLR.W D0 JMP (A2,D4) REPT 200 MOVE.W D1,(A3)+ ADD.W D2,D0 ADDX.W D3,D1 MOVE.W D5,(A3)+ ADD.W D6,D5 ENDR RIGHTJMP TST D7 BGT Right_lp ; Now draw on screen .gofordraw MOVE (SP)+,D7 ; DY MOVE (SP)+,D0 ; MIN Y SUBQ #1,D7 move.l colouradr2354,a5 MOVE.L workscr2354(PC),A6 MULU #xres*2,D0 ADDA.L D0,A6 LEA x1s(PC),A1 LEA x2s(PC),A2 MOVEQ #16-6,D3 MOVE.W #xres*2,D4 MOVEQ #0,D5 Gdraw_lp MOVE.W (A1)+,D0 ; x1 MOVE.W (A2)+,D6 ; x2 MOVE.W (A1)+,D1 ; Intensity 1 MOVE.W (A2)+,D2 ; Intensity 2 EXT.L D1 EXT.L D2 LEA (A6,D0.W*2),A0 SUB.W D0,D6 BLE DS2 SUB.L D1,D2 EXT.L D6 SWAP D2 DIVS.L D6,D2 ASR.L D3,d2 ASL.L #6,D1 SWAP D1 SWAP D2 MOVEQ #31,D0 AND.W D6,D0 LSR.W #5,D6 MOVE D5,CCR JMP ([jmptab,D0.W*4]) Glp REPT 32 MOVE.W (A5,D1*2),(A0)+ ADDX.L D2,D1 ENDR g_jmp DBF D6,Glp DS2 ADD.W D4,A6 DBF D7,Gdraw_lp polydone RTS i SET 0 jmptab REPT 32 DC.L g_jmp+i i SET i-6 ENDR DS.W 16 ; Create Multplication gradient table for poly edges @initgoraud LEA grad_table(PC),A0 MOVE #-320,D0 .lp1 MOVE.L #32768,D1 DIVS D0,D1 MOVE.W D1,(A0)+ ADDQ #1,D0 CMP #-1,D0 BNE.S .lp1 MOVE.W #-32768,(A0)+ MOVE.W #0,(A0)+ MOVE.W #32767,(A0)+ MOVEQ #2,D0 .lp2 MOVE.L #32768,D1 DIVS D0,D1 MOVE.W D1,(A0)+ ADDQ #1,D0 CMP #321,D0 BNE.S .lp2 RTS grad_table ds.w 642 x1s DS.L 201 x2s DS.L 201 trans_crds DS.W 200 workscr2354 ds.l 1 g_lightred i set 0 rept 32 dc.w (31*32*64)+(i*64)+(i) i set i+1 endr ds.w 16 g_green i set 0 rept 32 dc.w (1*32*64)+(i*64)+(1) i set i+1 endr ds.w 16 g_white i set 0 rept 32 dc.w (i*32*64)+(i*64)+(i) i set i+1 endr ds.w 16 g_brown i set 0 rept 32 dc.w (i*32*64)+((i/2)*64)+(2) i set i+1 endr ds.w 16 * * HLINE1.S * * @drawhline1 * * Draws a horizontal line in 8 bitplane mode. Clipping is implemented. * This routine only uses the six first bitplanes. * * In a0.l=screenadr d0=xmin d1=xmax * d2.l - d4.l =6 bitplanes * xres equ horizontal screen resolution * (destroys d0-d7/a0-a1) * * ex. move.l screen,a0 * move #-34,d0 left xcord * move #67,d1 right xcord * move.l #$0,d2 don't set bitplane 0 or 1 * move.l #$0000ffff,d3 set bitplane 3 * move.l #$ffffffff,d4 set bitplane 4 and 5 * bsr @drawhline1 * @drawhline1 cmp d0,d1 bgt .ok move d0,d7 move d1,d0 move d7,d1 .ok tst d0 ble .dl1 cmp #xres-1,d1 ble .dl4 cmp #xres-1,d0 bgt .ut move #xres-1,d1 .dl4 move d0,d5 move d5,d7 and.l #$fff0,d5 move d1,d6 and #$fff0,d6 cmp d5,d6 beq .shortline add.l d5,a0 and #$f,d0 lsl #2,d0 move.l #.leftmask,a1 move.l (a1,d0.w),d5 tst.l d2 beq .drw_a0 both zeroes tst d2 beq .drw_a1 zero and one swap d2 tst d2 beq .drw_a2 one and zero or.l d5,(a0)+ .drw_b tst.l d3 beq .drw_b0 both zeroes tst d3 beq .drw_b1 zero and one swap d3 tst d3 beq .drw_b2 one and zero or.l d5,(a0)+ .drw_c tst.l d4 beq .drw_c0 both zeroes tst d4 beq .drw_c1 zero and one swap d4 tst d4 beq .drw_c2 one and zero or.l d5,(a0)+ .drw_d addq.l #4,a0 sub d7,d1 not d7 and #$f,d7 sub d7,d1 subq #1,d1 bgt .dl1 .ut rts .drw_a0 not.l d5 and.l d5,(a0)+ not.l d5 bra .drw_b .drw_a2 not d5 and d5,(a0)+ not d5 or d5,(a0)+ swap d2 bra .drw_b .drw_a1 or d5,(a0)+ not d5 and d5,(a0)+ not d5 bra .drw_b .drw_b0 not.l d5 and.l d5,(a0)+ not.l d5 bra .drw_c .drw_b2 not d5 and d5,(a0)+ not d5 or d5,(a0)+ swap d3 bra .drw_c .drw_b1 or d5,(a0)+ not d5 and d5,(a0)+ not d5 bra .drw_c .drw_c0 not.l d5 and.l d5,(a0)+ not.l d5 bra .drw_d .drw_c2 not d5 and d5,(a0)+ not d5 or d5,(a0)+ swap d4 bra .drw_d .drw_c1 or d5,(a0)+ not d5 and d5,(a0)+ bra .drw_d * nda ut till vnster .dl1 tst d1 blt .ut cmp #xres-1,d1 bge .dl2 move d1,d0 addq #1,d0 lsr #4,d0 subq #1,d0 antal 16pix blt .dl5 .dl6 movem.l d2-d4,(a0) rita alla hela 16pix add.l #16,a0 dbra d0,.dl6 .dl5 and #$f,d1 rita resten cmp #15,d1 beq .dl7 lsl #2,d1 move.l #.rightmask,a1 move.l (a1,d1.w),d0 .rest tst.l d2 beq .dl8 both zeroes tst d2 beq .dl9 zero and one swap d2 tst d2 beq .dl9b one and zero or.l d0,(a0)+ .dl10 tst.l d3 beq .dl11 both zeroes tst d3 beq .dl12 zero and one swap d3 tst d3 beq .dl12b one and zero or.l d0,(a0)+ .dl13 tst.l d4 beq .dl14 both zeroes tst d4 beq .dl15 zero and one swap d4 tst d4 beq .dl15b one and zero or.l d0,(a0)+ .dl7 rts .dl8 not.l d0 and.l d0,(a0)+ not.l d0 bra .dl10 .dl9b not d0 and d0,(a0)+ not d0 or d0,(a0)+ swap d2 bra .dl10 .dl9 or d0,(a0)+ not d0 and d0,(a0)+ not d0 bra .dl10 .dl11 not.l d0 and.l d0,(a0)+ not.l d0 bra .dl13 .dl12b not d0 and d0,(a0)+ not d0 or d0,(a0)+ swap d3 bra .dl13 .dl12 or d0,(a0)+ not d0 and d0,(a0)+ not d0 bra .dl13 .dl14 not.l d0 and.l d0,(a0)+ rts .dl15b not d0 and d0,(a0)+ not d0 or d0,(a0)+ swap d4 rts .dl15 or d0,(a0)+ not d0 and d0,(a0)+ rts * Linjen r ver hela skrmen .dl2 move #xres/16/2-1,d5 .dl3 movem.l d2-d4,(a0) add.l #16,a0 movem.l d2-d4,(a0) add.l #16,a0 dbra d5,.dl3 rts * Linjen befinner sig i endast en 16pix .shortline add.l d5,a0 move.l #.shortmask,a1 and.l #$f,d0 lsl #6,d0 add.l d0,a1 and #$f,d1 lsl #2,d1 move.l (a1,d1.w),d0 bra .rest .shortmask dc.l $80008000,$c000c000,$e000e000,$f000f000 dc.l $f800f800,$fc00fc00,$fe00fe00,$ff00ff00 dc.l $ff80ff80,$ffc0ffc0,$ffe0ffe0,$fff0fff0 dc.l $fff8fff8,$fffcfffc,$fffefffe,$ffffffff dc.l $00000000,$40004000,$60006000,$70007000 dc.l $78007800,$7c007c00,$7e007e00,$7f007f00 dc.l $7f807f80,$7fc07fc0,$7fe07fe0,$7ff07ff0 dc.l $7ff87ff8,$7ffc7ffc,$7ffe7ffe,$7fff7fff dc.l $00000000,$00000000,$20002000,$30003000 dc.l $38003800,$3c003c00,$3e003e00,$3f003f00 dc.l $3f803f80,$3fc03fc0,$3fe03fe0,$3ff03ff0 dc.l $3ff83ff8,$3ffc3ffc,$3ffe3ffe,$3fff3fff dc.l $00000000,$00000000,$00000000,$10001000 dc.l $18001800,$1c001c00,$1e001e00,$1f001f00 dc.l $1f801f80,$1fc01fc0,$1fe01fe0,$1ff01ff0 dc.l $1ff81ff8,$1ffc1ffc,$1ffe1ffe,$1fff1fff dc.l $00000000,$00000000,$00000000,$00000000 dc.l $08000800,$0c000c00,$0e000e00,$0f000f00 dc.l $0f800f80,$0fc00fc0,$0fe00fe0,$0ff00ff0 dc.l $0ff80ff8,$0ffc0ffc,$0ffe0ffe,$0fff0fff dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000800,$04000400,$06000600,$07000700 dc.l $07800780,$07c007c0,$07e007e0,$07f007f0 dc.l $07f807f8,$07fc07fc,$07fe07fe,$07ff07ff dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$02000200,$03000300 dc.l $03800380,$03c003c0,$03e003e0,$03f003f0 dc.l $03f803f8,$03fc03fc,$03fe03fe,$03ff03ff dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$01000100 dc.l $01800180,$01c001c0,$01e001e0,$01f001f0 dc.l $01f801f8,$01fc01fc,$01fe01fe,$01ff01ff dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00800080,$00c000c0,$00e000e0,$00f000f0 dc.l $00f800f8,$00fc00fc,$00fe00fe,$00ff00ff dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00400040,$00600060,$00700070 dc.l $00780078,$007c007c,$007e007e,$007f007f dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00200020,$00300030 dc.l $00380038,$003c003c,$003e003e,$003f003f dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00100010 dc.l $00180018,$001c001c,$001e001e,$001f001f dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00080008,$000c000c,$000e000e,$000f000f dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00040004,$00060006,$00070007 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00020002,$00030003 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00000000 dc.l $00000000,$00000000,$00000000,$00010001 .rightmask dc.l $80008000,$c000c000,$e000e000,$f000f000 dc.l $f800f800,$fc00fc00,$fe00fe00,$ff00ff00 dc.l $ff80ff80,$ffc0ffc0,$ffe0ffe0,$fff0fff0 dc.l $fff8fff8,$fffcfffc,$fffefffe .leftmask dc.l $ffffffff,$7fff7fff,$3fff3fff,$1fff1fff,$0fff0fff dc.l $07ff07ff,$03ff03ff,$01ff01ff,$00ff00ff dc.l $007f007f,$003f003f,$001f001f,$000f000f dc.l $00070007,$00030003,$00010001 * * ICE.S * * @icedecrunch * * Checks if the data is icepacked and possibly unpacks it. * * In a0.l=Data adr. * ;********************************************* Unpacking routine of PACK-ICE ; a0 = AdTRESs of packed data ; "bsr" or "jsr" to ice_decrunch_2 with register a0 prepared. @icedecrunch link a3,#-120 movem.L d0-a6,-(sp) lea 120(a0),a4 move.L a4,a6 bsr .getinfo cmpi.L #'ICE!',d0 bne.S .not_packed bsr.s .getinfo lea.L -8(a0,d0.L),a5 bsr.s .getinfo move.L d0,(sp) adda.L d0,a6 move.L a6,a1 moveq #119,d0 .save move.B -(a1),-(a3) dbf d0,.save move.L a6,a3 move.B -(a5),d7 bsr.s .normal_bytes move.L a3,a5 bsr .get_1_bit bcc.s .no_picture move.W #$0f9f,d7 bsr .get_1_bit bcc.s .ice_00 moveq #15,d0 bsr .get_d0_bits move.W d1,d7 .ice_00 moveq #3,d6 .ice_01 move.W -(a3),d4 moveq #3,d5 .ice_02 add.W d4,d4 addx.W d0,d0 add.W d4,d4 addx.W d1,d1 add.W d4,d4 addx.W d2,d2 add.W d4,d4 addx.W d3,d3 dbra d5,.ice_02 dbra d6,.ice_01 movem.W d0-d3,(a3) dbra d7,.ice_00 .no_picture movem.L (sp),d0-a3 .move move.B (a4)+,(a0)+ subq.L #1,d0 bne.s .move moveq #119,d0 .TRESt move.B -(a3),-(a5) dbf d0,.TRESt .not_packed movem.L (sp)+,d0-a6 unlk a3 rts .getinfo moveq #3,d1 .getbytes lsl.L #8,d0 move.B (a0)+,d0 dbf d1,.getbytes rts .normal_bytes bsr.s .get_1_bit bcc.s .test_if_end moveq.L #0,d1 bsr.s .get_1_bit bcc.s .copy_direkt lea.L .direkt_tab+20(pc),a1 moveq.L #4,d3 .nextgb move.L -(a1),d0 bsr.s .get_d0_bits swap.W d0 cmp.W d0,d1 dbne d3,.nextgb .no_more add.L 20(a1),d1 .copy_direkt move.B -(a5),-(a6) dbf d1,.copy_direkt .test_if_end cmpa.L a4,a6 bgt.s .strings rts .get_1_bit add.B d7,d7 bne.s .Bitfound move.B -(a5),d7 addx.B d7,d7 .Bitfound rts .get_d0_bits moveq.L #0,d1 .hole_bit_loop add.B d7,d7 bne.s .on_d0 move.B -(a5),d7 addx.B d7,d7 .on_d0 addx.W d1,d1 dbf d0,.hole_bit_loop rts .strings lea.L .Length_tab(pc),a1 moveq.L #3,d2 .get_length_bit bsr.s .get_1_bit dbcc d2,.get_length_bit .no_length_bit moveq.L #0,d4 moveq.L #0,d1 move.B 1(a1,d2.W),d0 ext.W d0 bmi.s .no_ber .get_ber bsr.s .get_d0_bits .no_ber move.B 6(a1,d2.W),d4 add.W d1,d4 beq.s .get_offset_2 lea.L .more_offset(pc),a1 moveq.L #1,d2 .getoffs bsr.s .get_1_bit dbcc d2,.getoffs moveq.L #0,d1 move.B 1(a1,d2.W),d0 ext.W d0 bsr.s .get_d0_bits add.W d2,d2 add.W 6(a1,d2.W),d1 bpl.s .depack_bytes sub.W d4,d1 bra.s .depack_bytes .get_offset_2 moveq.L #0,d1 moveq.L #5,d0 moveq.L #-1,d2 bsr.s .get_1_bit bcc.s .Less_40 moveq.L #8,d0 moveq.L #$3f,d2 .Less_40 bsr.s .get_d0_bits add.W d2,d1 .depack_bytes lea.L 2(a6,d4.W),a1 adda.W d1,a1 move.B -(a1),-(a6) .dep_b move.B -(a1),-(a6) dbf d4,.dep_b bra .normal_bytes .direkt_tab dc.L $7fff000e,$00ff0007,$00070002,$00030001,$00030001 dc.L 270-1, 15-1, 8-1, 5-1, 2-1 .Length_tab dc.B 9,1,0,-1,-1 dc.B 8,4,2,1,0 .more_offset dc.B 11, 4, 7, 0 ; Bits lesen dc.W $11f, -1, $1f ; Standard Offset ende_ice_decrunch_2 * * Laddar in en fil och packar eventuellt upp den (ice 2.40). * a5.l=adr. till nollavslutat filnamn * a6.l=dest * d7.l=fillngd * include gem.s include ice.s @loadfile move #0,-(sp) move.l a5,-(sp) @gemdos $3d,8 move d0,d6 move.l a6,-(sp) move.l d7,-(sp) move d6,-(sp) @gemdos $3f,12 move d6,-(sp) @gemdos $3e,4 move.l a6,a0 bsr @icedecrunch rts move.l a7,a5 move.l 4(a5),a5 move.l a5,a6 move.l $c(a5),d0 add.l $14(a5),d0 add.l $1c(a5),d0 add.l #$500,d0 move.l d0,d1 add.l a5,d1 and.l #-2,d1 move.l d1,a7 move.l d0,-(sp) move.l a5,-(sp) clr.w -(sp) move #$4a,-(sp) trap #1 add.l #12,sp * * SAVEFILE.S * * @savefile * * Saves data as a file. * * In a5.l=adr. till nollavslutat filnamn * a6.l=source * d7.l=fillngd * include gem.s @savefile move #0,-(sp) create file move.l a5,-(sp) @gemdos $3c,8 move d0,d6 move.l a6,-(sp) write move.l d7,-(sp) move d6,-(sp) @gemdos $40,12 move d6,-(sp) close @gemdos $3e,4 rts * * SETFV.S * * @setfv * Sets the falcon video registers. The data that is * written to the video registers must be a .FV (Falcon Video) * file. Supervisor only. * In a0.l=adr. to Falcon Video data * Out d0.l: 0=no error -1=error, no FV data -2=error, wrong monitor (not used yet) * (destroys a0-a1) * * @savefv * Saves the falcon video registers to memory. Supervisor only. * (destroys a0-a1) * * @resorefv * Restores the saved falcon video registers. Supervisor only. * (destroys a0-a1) * @setfv cmp.l #'FVDO',(a0)+ 4 bytes header bne .error * cmp.b #0,$ff8006 * beq .sm124 * cmp.b #2,$ff8006 * beq .vga *.rgb cmp.b #0,(a0) * beq .wrongmon * cmp.b #2,(a0) * beq .wrongmon .ready addq.l #2,a0 move.l $70,-(sp) move sr,-(sp) move.l #.vbl,$70 move #$2300,sr move.l $466,d0 .wait cmp.l $466,d0 beq .wait move.l (a0)+,$ff820e offset & vwrap move.w (a0)+,$ff8266 spshift move.l #$ff8282,a1 horizontal control registers .loop1 move (a0)+,(a1)+ cmp.l #$ff8292,a1 bne .loop1 move.l #$ff82a2,a1 vertical control registers .loop2 move (a0)+,(a1)+ cmp.l #$ff82ae,a1 bne .loop2 move (a0)+,$ff82c2 video control move (sp)+,sr move.l (sp)+,$70 moveq #0,d0 rts .error moveq #-1,d0 rts .wrongmon moveq #-2,d0 rts .sm124 cmp.b #0,(a0) bne .wrongmon bra .ready .vga cmp.b #2,(a0) bne .wrongmon bra .ready .vbl addq.l #1,$466 rte @savefv lea FVbuffer1298,a1 move.l #'FVDO',(a1)+ 4 bytes header move.b $ff8006,(a1)+ monitor type move.b $ff820a,(a1)+ sync move.l $ff820e,(a1)+ offset & vwrap move.w $ff8266,(a1)+ spshift move.l #$ff8282,a0 horizontal control registers .loop1 move (a0)+,(a1)+ cmp.l #$ff8292,a0 bne .loop1 move.l #$ff82a2,a0 vertical control registers .loop2 move (a0)+,(a1)+ cmp.l #$ff82ae,a0 bne .loop2 move $ff82c2,(a1)+ video control rts @restorefv move.l #FVbuffer1298,a0 bsr @setfv rts FVbuffer1298 ds.w 22 * * SETVIDEO.S * * @setvideo * Save and set resolution. * In d7.w=mode * modeequates: vertflag, stmodes, overscan, pal, vga, col80, bps1-16 * ex. move #pal+bps16,d7 * (xbios) * * @restorevideo * Restores the saved resolution. * (xbios) * * @setvadr * Sets the physical and logical screenadress. * In d0.l=screenadr. * (xbios) * * @savevadr * Saves the current screenadr. * (xbios) * * @restorevadr * Restores the saved screenadr. * (xbios) * ; SetVideo() equates. vertflag EQU $0100 ; double-line on VGA, interlace on ST/TV ; stmodes EQU $0080 ; ST compatible (uses the ff8240 colour registers); overscan EQU $0040 ; Multiply X&Y rez by 1.2, ignored on VGA ; pal EQU $0020 ; PAL if set, else NTSC ; vga EQU $0010 ; VGA if set, else TV mode ; col80 EQU $0008 ; 80 column if set, else 40 column ; bps16 EQU $0004 ; True colour mode bps8 EQU $0003 ; 8 bitplanes ... etc. bps4 EQU $0002 bps2 EQU $0001 bps1 EQU $0000 @setvideo MOVE #37,-(SP) TRAP #14 ADDQ.L #2,SP MOVE.W #-1,-(SP) MOVE.W #$58,-(SP) TRAP #14 ADDQ.L #4,SP move d0,save4856 MOVE.W d7,-(SP) MOVE.W #$58,-(SP) TRAP #14 ADDQ.L #4,SP rts @restorevideo MOVE.W save4856,-(SP) MOVE.W #$58,-(SP) TRAP #14 ADDQ.L #4,SP rts @savevadr move #2,-(sp) trap #14 addq.l #2,sp move.l d0,scradr7112 rts @restorevadr move #-1,-(sp) move.l scradr7112,-(sp) move.l scradr7112,-(sp) move #5,-(sp) trap #14 lea 12(sp),sp rts @setvadr move #-1,-(sp) move.l d0,-(sp) move.l d0,-(sp) move #5,-(sp) trap #14 lea 12(sp),sp rts save4856 ds.w 1 scradr7112 ds.l 1 * * SHRTONES.S * * @super * enter supervisor mode gemdos($20) * * @user * returns to user mode gemdos($20) * * @waitvbl * waits for a vertical blank xbios(#37) * * @waitkey * waits for a keypress, no echo gemdos(#7) * Out d0.b=ascii value * * @exitifkey * quits if a key has been pressed * gemdos(#11), gemdos(#7) * * @quit * terminate process gemdos(#0) * @super clr.l -(sp) move #$20,-(sp) trap #1 addq.l #6,sp move.l d0,savedsp0673 rts savedsp0673 ds.l 1 @user move.l savedsp0673,-(sp) move #$20,-(sp) trap #1 addq.l #6,sp rts @waitvbl move #37,-(sp) trap #14 addq.l #2,sp rts @waitkey move #7,-(sp) trap #1 addq.l #2,sp rts @exitifkey move #11,-(sp) trap #1 addq.l #2,sp tst.l d0 blt .ut rts .ut bsr @waitkey move.l #@quit,(sp) rts @quit clr -(sp) trap #1 ;Yw$A_ | ' D a } 'B]x 9Sl(?Vl ! !"4"#G#$Z$%l%&}''(()$)*2*+@+,M,-Y-.d./n/0w01223 3445566778899::;;<<==> >???@{@AqABfBCZCDLDE>EF-FGGH HHIjIJSJK;KL"LMMyMN\NO=OPPPQjQRFRS SSTdTU:UVVyVWKWXXXYPYZZZ[K[\\u\]:]]^^^__~_`;``aTab bhbccxcd+dde4eef8ffg8ggh4hhi*i|ijjljk kXkkl?llm"mlmnnInno ofoop7p|pqqFqqr rLrrs sIsstt=txttu(uauuv v@vwvvwwKw~wwxxFxwxxyy4yayyyzz=zgzzz{ {0{W{}{{{||1|S|u||||}}2}P}m}}}}}~ ~%~=~T~k~~~~~~~ ,<KZhuuhZK<, ~~~~~~~~k~T~=~%~ }}}}}}m}P}2}|||||u|S|1|{{{{}{W{0{ zzzzgz=zyyyyay4yxxxwxFxwww~wKwvvvwv@v uuuau(tttxt=tsssIs rrrLr qqqFqpp|p7ooofo nnnInmmlm"lll?kkkXk jjljii|i*hhh4ggg8fff8eee4ddd+ccxcbbhb aaT```;__~_^^^]]]:\\u\[[KZZZYYPXXXWWKVVyVUU:TTdSSS RRFQQjPPPOO=NN\MMyMLL"KK;JJSIIjHHH GGFF-EE>DDLCCZBBfAAq@@{???>> ==<<;;::99887766554433 22100w//n..d--Y,,M++@**2))$((''&}%%l$$Z##G""4!! lV?(lS9 x]B' } a D ' |_A$wY;rT6kN0gJ.gL0mS:!|dL6 jVBܹ/ۦڔ كscUG:ӳ-ҧ"ќВω΁ztnjgeddehkpv}  -;ºJӹ[m !8ŴQ޳k3ðSt(Mt0ƪ[񩇩M~JQ(ƢdB⠂#şg P=✈.՛|$̚ușrȘs ̗z'֖4㕔EZ u)ޒJo'Sɏ@x6t5y<ËM؊f.SꈵO뇺Y*̆rEÅpGЄ^9σjI) ΂w\A& ہÁiU@-ԀĀ~rg\QH?6.'!  !'.6?HQ\gr~ĀԀ-@UiÁہ &A\w΂ )Ijσ9^ЄGpÅEr̆*YOS.f؋MÌ h""   <. NN.. PACKTEXT NNGEM_TUT 009ON. NN.. NNPACKTEXTC [PACKTEXTPRG [_`/************************************************************************/ /* PACKTEXT.C - Play with Text Packing using Huffman Codes */ /* Copyright 1986 Daniel Matejka */ /* 23 Aug 86 - 10:00 */ /************************************************************************/ #include #include #include /* encodable ASCII codes (all 256) and size of unpack tree */ #define CODECOUNT 256 #define PTREESIZE (CODECOUNT+10) /* maximum size of text buffers */ #define MAXTEXT 3000 /* menu indices */ #define DESKMENU 3 #define FILEMENU 4 #define HUFFMENU 5 #define WINDMENU 6 #define PACKFILE 18 #define UNPACKFILE 19 #define SAVECODES 20 #define LOADCODES 21 #define INCLCODES 23 #define QUIT 25 #define GENERATE 27 #define PRINTCODES 28 #define FSTWINDOW 30 /* window indices */ #define WINDCNT 3 #define TXTWIND 0 #define INFWIND 1 #define CDEWIND 2 int contrl[12], intin[128], intout[128], ptsin[128], ptsout[128], /* GEM silliness */ schandle, /* screen (workstation) handle */ cellheight, cellwidth, /* system character cell size */ scrxmax, scrymax, /* screen size */ cwindtop, /* top line of codewindow */ menusize, /* number of bytes in menu bar */ window[WINDCNT], /* window handles */ windattrib[WINDCNT], /* window attributes */ windopen[WINDCNT], /* windows open flag */ windrect[WINDCNT][4], /* window work area position and size */ message[8], /* GEM event message buffer */ trash; char pathname[60], /* path and filenames from human */ filename[60], *menusave; /* safe area in which to store menu bar */ struct PSTATS { /* some interesting packing statistics */ long psplen, /* length of packed text (bytes) */ psulen, /* length of original unpacked text */ pspeffic, /* packing efficiency */ psteffic; /* efficiency of packing table */ } packstats; /* list of relative frequencies; default value included */ long textprobs[CODECOUNT] = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 169, 0, 0, 169, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,2095, 0, 18, 0, 0, 5, 0, 16, 25, 25, 5, 0, 83, 2, 100, 0, 19, 22, 4, 2, 2, 4, 0, 1, 1, 0, 2, 3, 0, 1, 0, 0, 0, 14, 2, 20, 3, 13, 7, 4, 11, 23, 0, 3, 1, 6, 6, 7, 8, 0, 4, 9, 40, 4, 0, 3, 3, 0, 0, 4, 0, 4, 0, 2, 0, 530, 135, 277, 276, 926, 205, 117, 323, 538, 8, 58, 302, 140, 491, 471, 164, 14, 400, 453, 662, 205, 45, 121, 32, 79, 10 }; /* table of Huffman Codes */ struct PACKTABLE { unsigned char ptsymb, /* unpacked character */ ptlen; /* # bits used in Huffman Code */ unsigned int ptimage; /* Huffman Code */ } packtable[CODECOUNT]; /* tree for unpacking Huffman Codes */ int packtree[PTREESIZE][2]; /* window text display buffer */ struct TEXTREC { char *trtext, /* beginning of text */ **trlines; /* line starts */ int trtopline, /* line number at top of window */ trlcount, /* # of lines in text */ trwindow; /* window index */ } otext; /* unpacked text */ /************************************************************************/ /**************************** The Resources *****************************/ /************************************************************************/ char *wmenustr[] = { " Open Text Window", " Open Pack Data Window", " Open Code Window", " Close Text Window", " Close Pack Data Window", " Close Code Window" }; /********** (the menu) **********/ OBJECT menudata[] = { -1,1,7,G_IBOX,NONE,NORMAL,0x0L, 0,0,45,0x309, 7,2,2,G_BOX,NONE,NORMAL,0x1100L, 0,0,30,0x201, 1,3,6,G_IBOX,NONE,NORMAL,0x0L, 2,0,28,0x301, 4,-1,-1,G_TITLE,NONE,NORMAL," Desk ", 0,0,6,0x301, 5,-1,-1,G_TITLE,NONE,NORMAL," File ", 6,0,6,0x301, 6,-1,-1,G_TITLE,NONE,NORMAL," Codes ", 12,0,7,0x301, 2,-1,-1,G_TITLE,NONE,NORMAL," Windows ", 19,0,9,0x301, 0,8,29,G_IBOX,NONE,NORMAL,0x0L, 0,0x301,45,8, 17,9,16, G_BOX,NONE,NORMAL,0xFF1100L, 2,0,20,8, 10,-1,-1,G_STRING,NONE,NORMAL," About PackText", 0,0,20,1, 11,-1,-1,G_STRING,NONE,DISABLED,"--------------------", 0,1,20,1, 12,-1,-1,G_STRING,NONE,NORMAL,"", 0,2,20,1, 13,-1,-1,G_STRING,NONE,NORMAL,"", 0,3,20,1, 14,-1,-1,G_STRING,NONE,NORMAL,"", 0,4,20,1, 15,-1,-1,G_STRING,NONE,NORMAL,"", 0,5,20,1, 16,-1,-1,G_STRING,NONE,NORMAL,"", 0,6,20,1, 8,-1,-1,G_STRING,NONE,NORMAL,"", 0,7,20,1, 26,18,25,G_BOX,NONE,NORMAL,0xFF1100L, 6,0,25,8, 19,-1,-1,G_STRING,NONE,NORMAL," Pack a File", 0,0,25,1, 20,-1,-1,G_STRING,NONE,NORMAL," Unpack a File", 0,1,25,1, 21,-1,-1,G_STRING,NONE,NORMAL," Save Huffman Codes", 0,2,25,1, 22,-1,-1,G_STRING,NONE,NORMAL," Load Huffman Codes", 0,3,25,1, 23,-1,-1,G_STRING,NONE,DISABLED,"-------------------------",0,4,25,1, 24,-1,-1,G_STRING,NONE,CHECKED," Include Codes in File", 0,5,25,1, 25,-1,-1,G_STRING,NONE,DISABLED,"-------------------------",0,6,25,1, 17,-1,-1,G_STRING,NONE,NORMAL," Quit", 0,7,25,1, 29,27,28,G_BOX,NONE,NORMAL,0xFF1100L, 12,0,26,2, 28,-1,-1,G_STRING,NONE,NORMAL," Generate Huffman Codes", 0,0,26,1, 26,-1,-1,G_STRING,NONE,NORMAL," Print Huffman Codes", 0,1,26,1, 7,30,32,G_BOX,NONE,NORMAL,0xFF1100L, 19,0,26,3, 31,-1,-1,G_STRING,NONE,NORMAL,"", 0,0,26,1, 32,-1,-1,G_STRING,NONE,NORMAL,"", 0,1,26,1, 29,-1,-1,G_STRING,LASTOB,NORMAL,"", 0,2,26,1 }; /* "About" dialog box */ OBJECT glorybox[] = { -1,1,5,G_BOX,NONE,OUTLINED,0x22100L,0,0,35,10, 2,-1,-1,G_STRING,NONE,NORMAL, "PackText uses Huffman Codes",4,2,29,1, 3,-1,-1,G_STRING,NONE,NORMAL,"to compress and decompress",2,3,31,1, 4,-1,-1,G_STRING,NONE,NORMAL,"text files.",2,4,31,1, 5,-1,-1,G_STRING,NONE,NORMAL,"Copyright 1986 Daniel Matejka",2,6,31,1, 0,-1,-1,G_BUTTON,LASTOB|EXIT|DEFAULT|SELECTABLE,NORMAL,"OK",15,8,6,1, }; /* object list for coordinate fix */ OBJECT *oblist[] = { menudata,glorybox,0 }; /************************************************************************/ /****************************** Miscellany ******************************/ /************************************************************************/ /********** copy one string into another **********/ strcpy(dest,source) register char *dest,*source; { while (*dest++ = *source++); } /* end strcpy */ /********** concatenate two strings **********/ strconc(dest,appendage) register char *dest,*appendage; { while (*dest++); dest--; while (*dest++ = *appendage++); } /* end strconc */ /********** move memory around **********/ movmem(s,d,c) register char *s,*d; register int c; { if (s > d) while (c-- > 0) *d++ = *s++; else { d += c; s += c; while (c-- > 0) *--d = *--s; } } /* end movmem */ /********** initialize memory **********/ setmem(d,c,v) register char *d; register int c,v; { while (c-- > 0) *d++ = v; } /* end setmem */ /********** concatenate a string and a longint **********/ longconc(s,it,decimal,digits,zeroes) char *s; /* string on which to append the longint */ long it; /* the longint */ int decimal, /* # of digits to right of decimal pt for display */ digits, /* # of spaces in which to display the longint */ zeroes; { /* pack on left with zeroes? */ /* Note if (digits == 0), use as many digits as necessary (left justify) */ int sign; char sbuf[14], *slider; if (sign = it < 0) /* make it positive */ it *= -1; zeroes = zeroes ? '0' : ' '; /* left padding character */ if (decimal > 0 && digits > 0) digits++; if (digits) slider = sbuf+digits; else slider = sbuf+12; /* largest possible, fix later */ *slider = 0; /* turn longint into a string */ do { *--slider = (it - 10*(it/10)) + '0'; /* long mod doesn't work */ if (--decimal == 0) *--slider = '.'; it /= 10; } while (it > 0 && slider > sbuf); /* add sign */ if (sign && slider > sbuf) *--slider = '-'; /* add decimal point */ if (decimal > 0) { while (--decimal >= 0 && slider > sbuf) *--slider = '0'; if (slider > sbuf) *--slider = '.'; } /* justify, right or left as requested */ if (digits) while (slider > sbuf) *--slider = zeroes; else { digits = 12 - (slider-sbuf); movmem(slider,sbuf,1 + digits); } strconc(s,sbuf); } /* end longconc */ /************************************************************************/ /********************* Text Buffer Display Routines *********************/ /************************************************************************/ /********** initialize text buffer **********/ int tenew(text,windx) struct TEXTREC *text; int windx; { int ctr; text->trtext = Malloc((long) MAXTEXT); text->trtopline = 0; text->trlcount = 0; text->trwindow = windx; text->trlines = Malloc( (long) (MAXTEXT/2 * sizeof(char *)) ); /* if any allocations failed, reverse whatever was done and return 0 */ if (text->trtext == 0 || text->trlines == 0) { if (text->trtext != 0) Mfree(text->trtext); if (text->trlines != 0) Mfree(text->trlines); return 0; } for (ctr = 0; ctr < MAXTEXT/2; ctr++) text->trlines[ctr] = text->trtext; return 1; } /* end tenew */ /********** find width of character cell (proportional font?) **********/ static int charwidth(it) int it; { int width; vqt_width(schandle,it,&width,&trash,&trash); return width; } /* end charwidth */ /********** find a real line end **********/ static char *lineadjust(linebeg,teptr) char *linebeg,*teptr; { char *pushpos; pushpos = teptr; /* find last blank on line currently ending at teptr */ while (*teptr != ' ' && teptr > linebeg) teptr--; if (teptr == linebeg) /* none such */ return pushpos; /* find last non-blank character on line */ pushpos = teptr+1; /* first character after last blank */ while (*teptr == ' ' && teptr > linebeg) teptr--; /* return 1st char after last blank, or last non-blank + spacer */ teptr += (*teptr == '.') ? 3 : 2; return (teptr > pushpos) ? pushpos : teptr; } /* end lineadjust */ /********** calculate line starts **********/ tecalc(text) struct TEXTREC *text; { register char *teptr, /* text array pointer */ *teend; /* end of text */ char *tlinestart = text->trlines[text->trtopline]; register int line, /* line counter */ linewidth; /* width as it is built */ int width, /* character width variable (proportional font?) */ windwidth = windrect[text->trwindow][2]; /* start scanning at text beginning, with 0 lines */ line = 0; text->trlines[0] = text->trtext; teptr = text->trtext; teend = text->trlines[text->trlcount]; while (teptr < teend) { /* while scanner is within text buffer */ /* count character widths until end of window is reached */ for (linewidth = 0; linewidth <= windwidth && *teptr != '\n' && teptr < teend; linewidth += charwidth(*teptr++)); /* if end of window or '\n', a new line begins somewhere close */ if (linewidth > windwidth || (*teptr == '\n' && teptr < teend)) { if (*teptr == '\n') teptr++; else teptr = lineadjust(text->trlines[line],teptr-1); text->trlines[++line] = teptr; } } /* end while */ /* adjust other variables that need adjusting */ text->trlcount = ++line; text->trlines[line] = teend; /* reset trtopline */ for (line = text->trlcount; text->trlines[line] > tlinestart; line--); text->trtopline = line; setsliders(text->trwindow,1,1); } /* end tecalc */ /********** display text buffer **********/ teupdate(text) struct TEXTREC *text; { int line, /* line index */ lastline, /* last displayable text line */ linelen, /* length of each line */ x,y; /* beginning position of each line */ char dspline[80], *seek; clrwindow(text->trwindow); v_hide_c(schandle); x = windrect[text->trwindow][0]; y = windrect[text->trwindow][1]; lastline = text->trtopline + windrect[text->trwindow][3]/cellheight; lastline = lastline > text->trlcount ? text->trlcount : lastline; for (line = text->trtopline; line < lastline; line++) { /* for each line */ /* copy line into display buffer */ linelen = text->trlines[line+1] - text->trlines[line]; movmem(text->trlines[line],dspline,linelen); /* search for first printable character at end, omitting spaces */ seek = dspline + linelen; while (--seek > dspline && *seek <= ' '); if (*seek > ' ') seek++; *seek = 0; /* and print it */ y += cellheight; v_gtext(schandle,x,y,dspline); } v_show_c(schandle,1); } /* end teupdate */ /************************************************************************/ /************************ Huffman Code Analyzers ************************/ /************************************************************************/ /********** Assign initial code lengths from frequency distribution **********/ static makeclens() { long divider; int ctr,curlen; divider = 5000; /* == 0.5, or length 1 */ curlen = 1; /* length 1 */ for (ctr = 0; ctr < CODECOUNT; ctr++) { /* for each ASCII symbol */ while (textprobs[ctr] < divider) { /* calculate a good... */ divider /= 2; curlen++; /* code length */ } packtable[ctr].ptlen = curlen; /* and assign it */ } } /* end makeclens */ /********** assign Huffman Codes from code length array **********/ static int assigncodes(start) int start; { int ctr, dlength, /* change in code length between consecutive codes */ traitor; /* index of first code which doesn't work */ /* following algorithms assume start > 0, so take care of start == 0 */ if (start <= 0) { packtable[0].ptimage = 0; start = 1; } /* each code is preceding code + 1, with zeroes tacked on as necessary */ for (ctr = start; ctr < CODECOUNT; ctr++) { packtable[ctr].ptimage = packtable[ctr-1].ptimage + 1; dlength = packtable[ctr].ptlen - packtable[ctr-1].ptlen; packtable[ctr].ptimage <<= dlength; } /* find index to first code which doesn't work */ for (traitor = -1, ctr = start; ctr < CODECOUNT; ctr++) if (packtable[ctr].ptimage >= (1 << packtable[ctr].ptlen)) { traitor = ctr; break; } return traitor; } /* end assigncodes */ /********** calculate unpacktree from Huffman Code table **********/ maketree() { int ctr, bumppt, /* index of lengths currently being tweaked */ nextpt, /* next point while traversing packtree */ branch, /* branch to take while traversing packtree */ mask; /* for traversing Huffman code */ /* initialize tree */ for (ctr = 0; ctr < PTREESIZE; ctr++) { packtree[ctr][0] = -CODECOUNT; packtree[ctr][1] = -CODECOUNT; } for (bumppt = 0, ctr = 0; ctr < CODECOUNT && bumppt < PTREESIZE-1; ctr++) { /* for each code */ /* for each bit in code (save the last one), traverse the tree */ for (nextpt = 0, mask = 1 << (packtable[ctr].ptlen - 1); mask > 1; mask >>= 1) { /* if branch is illegal value, insert new value */ branch = (packtable[ctr].ptimage & mask) != 0; if (packtree[nextpt][branch] <= -CODECOUNT) packtree[nextpt][branch] = ++bumppt; nextpt = packtree[nextpt][branch]; } /* for last bit, enter the unpacked symbol */ branch = (packtable[ctr].ptimage & 1) != 0; packtree[nextpt][branch] = packtable[ctr].ptsymb; packtree[nextpt][branch] *= -1; } if (bumppt >= PTREESIZE) form_alert(1, "[3][Unpacktree overflowed.|Don't attempt to unpack|anything.][Not OK]"); } /* end maketree */ /********** assign Huffman codes from frequency distribution **********/ huffmans() { int ctr, bumppt; /* index of lengths currently being tweaked */ /* find a set of Huffman Codes which do indeed work */ makeclens(); /* initial approximation at code lengths */ bumppt = 0; while ((bumppt = assigncodes(bumppt)) >= 0) { /* if doesn't work, */ packtable[bumppt].ptlen++; /* increment length */ for (ctr = bumppt+1; ctr < CODECOUNT; ctr++) if (packtable[ctr].ptlen < packtable[ctr-1].ptlen) packtable[ctr].ptlen = packtable[ctr-1].ptlen; } /* fine tune it */ bumppt = 0; do { /* attempt to drop length of every code, from the beginning */ do { /* drop value of lengths[bumppt] until it no longer works */ packtable[bumppt].ptlen--; } while (packtable[bumppt].ptlen > 0 && (bumppt == 0 || packtable[bumppt].ptlen >= packtable[bumppt-1].ptlen) && assigncodes(bumppt) < 0); /* restore last length (which did work), then try next one */ packtable[bumppt].ptlen++; assigncodes(bumppt); } while (++bumppt < CODECOUNT); /* codelengths now OK; assign final codes */ assigncodes(0); /* make the unpack tree */ maketree(); /* calculate table efficiency parameter */ for (packstats.psteffic = 0, ctr = 0; ctr < CODECOUNT; ctr++) packstats.psteffic += packtable[ctr].ptlen * textprobs[ctr]; packstats.psteffic /= 8; } /* end huffmans */ /********** sort a FREQSTRUCT and PACKTABLE by frequency **********/ sortptable() { int ctr, seek; long tfreq; /* temporary frequency variable for swapping */ struct PACKTABLE tptable; /* same for PACKTABLE entry */ for (ctr = 1; ctr < CODECOUNT; ctr++) { /* for each code past first, */ /* find where it goes in the previous sorted part of the array */ for (seek = 0; seek < ctr && textprobs[seek] >= textprobs[ctr]; seek++); /* and put it there */ if (seek < ctr) { tfreq = textprobs[ctr]; movmem(&textprobs[seek],&textprobs[seek+1], sizeof(long) * (ctr-seek)); textprobs[seek] = tfreq; movmem(&packtable[ctr],&tptable,sizeof(struct PACKTABLE)); movmem(&packtable[seek],&packtable[seek+1], sizeof(struct PACKTABLE) * (ctr-seek)); movmem(&tptable,&packtable[seek],sizeof(struct PACKTABLE)); } } } /* end sortptable */ /********** do the real work of loadfreqs() **********/ int maketables(fhandle,flength,fbuffer) int fhandle; /* file handle */ long flength; /* length of file */ unsigned char *fbuffer; { /* read buffer, length is assumed MAXTEXT */ register unsigned char *fbufend, /* working end of fbuffer */ *fbufscan; /* scanner down length of fbuffer */ int ctr, done; /* successful table creation? */ long iolength, /* length of each read operation */ charcount; /* count of packable characters */ /* initialize frequency table */ for (ctr = 0; ctr < CODECOUNT; ctr++) { packtable[ctr].ptsymb = ctr; textprobs[ctr] = 0L; } charcount = 0; done = 1; /* read file, count occurrences of each ASCII symbol */ Fseek(0L,fhandle,0); while (flength > 0) { iolength = flength > MAXTEXT ? MAXTEXT : flength; flength -= iolength; if (iolength != Fread(fhandle,iolength,fbuffer)) { done = 0; form_alert(1,"[3][Read error][Abort]"); break; } fbufend = fbuffer + iolength; for (fbufscan = fbuffer; fbufscan < fbufend; fbufscan++) { if (*fbufscan < CODECOUNT) { textprobs[*fbufscan] += 10000L; charcount++; } else { done = 0; form_alert(1,"[3][File contains characters|not allowed in tables][Abort]"); break; } } } /* end while (flength) */ Fseek(0L,fhandle,0); /* normalize */ for (ctr = 0; ctr < CODECOUNT; ctr++) textprobs[ctr] /= charcount; if (done) { /* if successfully loaded frequency table, finish the job */ sortptable(); huffmans(); } return done; } /* end maketables */ /********** construct a frequency distribution table **********/ int loadfreqs() { int fhandle, /* file handle */ done; char *fbuffer; /* file input buffer */ long flength; /* total file length */ if (!getfname(pathname,filename,"Select File to be Analyzed")) return 0; if ((fhandle = Fopen(filename,0)) < 0) { form_alert(1,"[3][Can't find that file.][ OK ]"); return 0; } fbuffer = Malloc((long) MAXTEXT); if (fbuffer == 0) { form_alert(1,"[3][No memory free!][ Ack ]"); Fclose(fhandle); return 0; } flength = Fseek(0L,fhandle,2); done = maketables(fhandle,flength,fbuffer); Mfree(fbuffer); Fclose(fhandle); return done; } /* end loadfreqs */ /********** save Huffman Code table **********/ savecodes() { int fhandle; /* file handle */ if (!getfname(pathname,filename,"Select File In Which to Save Codes")) return; if ((fhandle = Fopen(filename,0)) >= 0) { Fclose(fhandle); if (2 == form_alert(1, "[2][That file already exists][Overwrite|Stop]")) return; } if ((fhandle = Fcreate(filename,0)) < 0) { form_alert(1,"[3][Can't create that file][ Abort ]"); return; } if (Fwrite(fhandle,(long) sizeof(packtable),packtable) != sizeof(packtable)) form_alert(1,"[3][Write error][Abort]"); else form_alert(1,"[1][Code table written][ OK ]"); Fclose(fhandle); } /* end savecodes */ /********** read Huffman Code table **********/ int loadcodes() { int ctr, fhandle; /* file handle */ if (!getfname(pathname,filename,"Select File From Which to Load Codes")) return; if ((fhandle = Fopen(filename,0)) < 0) { form_alert(1,"[3][Can't open that file][ Abort ]"); return; } if (Fread(fhandle,(long) sizeof(packtable),packtable) != sizeof(packtable)) { form_alert(1,"[3][Read error:|Code tables are damaged.][Abort]"); return; } Fclose(fhandle); /* finish making Huffman Codes, adjust textprobs[] array and statistics */ maketree(); for (ctr = 0; ctr < CODECOUNT; ctr++) textprobs[ctr] = 10000L/CODECOUNT; for (packstats.psteffic = 0, ctr = 0; ctr < CODECOUNT; ctr++) packstats.psteffic += packtable[ctr].ptlen; packstats.psteffic *= 1250; /* (effic*10000/8) */ } /* end loadcodes */ /********** make a string for printing an entry of the code table **********/ makecstring(str,indx,toscreen) char *str; int indx,toscreen; { int bit, symbol = packtable[indx].ptsymb, whitespace = toscreen ? 4 : 9; char blanks[20]; blanks[whitespace] = 0; setmem(blanks,whitespace,' '); strcpy(str,blanks); if (toscreen) if (symbol == 0) strconc(str,"Null"); else { strconc(str," "); str[whitespace+2] = symbol; } else if (symbol >= ' ' && symbol <= '~') { strconc(str," "); str[whitespace+5] = symbol; } else { strconc(str,"chr("); longconc(str,(long) symbol,0,3,0); strconc(str,")"); } /* print frequency of occurrence, code length */ strconc(str,blanks); longconc(str,textprobs[indx],4,5,0); strconc(str,blanks); longconc(str,(long) packtable[indx].ptlen,0,2,0); /* print code */ strconc(str,"/"); for (bit = 15; bit >= 0; bit--) if (packtable[indx].ptimage & (1 << bit)) strconc(str,"1"); else if (bit < packtable[indx].ptlen) strconc(str,"0"); else strconc(str," "); } /* end makecstring */ /********** put a string on the printer **********/ printstr(str) char *str; { char *scan; for (scan = str; *scan; scan++) Cprnout(*scan); Cprnout('\r'); Cprnout('\n'); } /* end printstr */ /********** print Huffman Code table **********/ printcodes() { int ctr, line; char msg[80]; /* get the printer turned on */ do { evnt_timer(50,0); if (!(ctr = Cprnos()) && 2 == form_alert(1, "[1][Please turn on|the printer][ OK | Abort ]")) return; } while (!ctr); /* print each line of the code table */ for (ctr = 0, line = 54; ctr < CODECOUNT; ctr++, line++) { if (line >= 54) { /* paginate at line 54 */ printstr(" Char Frequency Length/Code\n"); line = 2; } makecstring(msg,ctr,0); printstr(msg); if (line == 53) Cprnout('\f'); } strcpy(msg,"\nEfficiency rating "); longconc(msg,packstats.psteffic,4,0,0); printstr(msg); } /* end printcodes */ /************************************************************************/ /********************* Packing and Unpacking Routines *******************/ /************************************************************************/ /********** prepare to read and write some files **********/ int openfiles(ihandle,ohandle,ibuffer,obuffer) int *ihandle,*ohandle; char **ibuffer,**obuffer; { /* open an input file */ if (!getfname(pathname,filename,"Select Input File")) return 0; if ((*ihandle = Fopen(filename,0)) < 0) { form_alert(1,"[3][Can't find that file][ Abort ]"); return 0; } /* open an output file */ if (!getfname(pathname,filename,"Select Output File")) return 0; if ((*ohandle = Fopen(filename,0)) >= 0) { Fclose(*ohandle); if (2 == form_alert(1, "[2][That file already exists][Overwrite|Stop]")) { Fclose(*ihandle); return 0; } } if ((*ohandle = Fcreate(filename,0)) < 0) { form_alert(1,"[3][Can't create that file][ Abort ]"); Fclose(*ihandle); return 0; } /* allocate input and output buffers, length MAXTEXT */ *ibuffer = Malloc((long) MAXTEXT); *obuffer = Malloc((long) MAXTEXT); if (*ibuffer == 0 || *obuffer == 0) { if (*obuffer != 0) Mfree(*obuffer); if (*ibuffer != 0) Mfree(*ibuffer); form_alert(1,"[3][No memory for packing!][ Abort ]"); Fclose(*ohandle); Fclose(*ihandle); return 0; } return 1; } /* end openfiles */ /********** reverse openfiles **********/ closefiles(ihandle,ohandle,ibuffer,obuffer) int ihandle,ohandle; char *ibuffer,*obuffer; { Mfree(obuffer); Mfree(ibuffer); Fclose(ohandle); Fclose(ihandle); } /* end closefiles */ /********** pack a file **********/ packtext() { unsigned register int row, /* row of codes corresponding to char being packed */ pmask, /* mask for selecting individual bits of pack stream */ imagemask; /* mask for selecting the image bit in question */ register unsigned char *pscan, /* grosser, 8-bit version of pmask */ *pend, /* end of pack buffer */ *uscan, /* unpacked characters */ *uend; /* end of unpack buffer */ unsigned char *ubuffer, /* memory buffer from unpacked file */ *pbuffer; /* memory buffer into which packed file is built */ int ihandle, /* input file handle */ ohandle, /* output file handle */ ioerror, /* did an i/o error occur? */ firstread, /* first read operation */ writetable = (menudata[INCLCODES].ob_state & CHECKED) != 0; long ilength, /* input file length */ iolength, /* i/o operation length */ olenpos, /* position in output file of character count */ packlen; /* output file character count */ /* get file handles and allocate i/o buffers */ if (!openfiles(&ihandle,&ohandle,&ubuffer,&pbuffer)) return; /* initialize error flag, first i/o operation flag, statistics and file length variables (packstats.psulen set later) */ packstats.psplen = 0; ioerror = 0; firstread = windopen[TXTWIND]; /* don't update window if not open */ ilength = Fseek(0L,ihandle,2); Fseek(0L,ihandle,0); if (writetable && !maketables(ihandle,ilength,ubuffer)) { closefiles(ihandle,ohandle,ubuffer,pbuffer); return; } /* write packtable if requested */ if (Fwrite(ohandle,(long) sizeof(int),&writetable) == sizeof(int)) { if (writetable && Fwrite(ohandle,(long) sizeof(packtable),packtable) != sizeof(packtable)) ioerror = 2; } else ioerror = 2; /* remember where file length field goes and make space for it */ olenpos = Fseek(0L,ohandle,1); if (!ioerror && Fwrite(ohandle,(long) sizeof(long),&packlen) != sizeof(long)) ioerror = 2; /* read entire input file */ for (packlen = 0, *(pscan=pbuffer) = 0, pend = pbuffer + MAXTEXT, pmask = 0x80, uscan = uend = ubuffer, packstats.psulen = 0; !ioerror && (ilength > 0 || uscan < uend); packstats.psulen++, uscan++) { /* if input buffer entirely processed, refill it */ if (uscan >= uend) { iolength = ilength > MAXTEXT ? MAXTEXT : ilength; ilength -= iolength; if (Fread(ihandle,iolength,ubuffer) != iolength) ioerror = 1; uscan = ubuffer; uend = ubuffer + iolength; if (firstread) { /* save file beginning for display */ firstread = 0; movmem(ubuffer,otext.trtext,(int) iolength); otext.trlcount = 1; otext.trlines[1] = otext.trtext + iolength; otext.trtopline = 0; tecalc(&otext); } } /* find out which row of Huffman Code Table applies */ for (row = 0; row < CODECOUNT && *uscan != packtable[row].ptsymb; row++); if (row < CODECOUNT) { /* if packable character */ packlen++; /* accessing each bit of packimage in order... */ for (imagemask = 1 << (packtable[row].ptlen - 1); imagemask > 0; imagemask >>= 1) { /* add that bit of packimage to end of packstream */ if (packtable[row].ptimage & imagemask) *pscan |= pmask; /* go to next bit of packstream */ pmask >>= 1; if (pmask == 0) { /* then go to next byte */ packstats.psplen++; pmask = 0x80; if (++pscan >= pend) { /* then flush buffer */ if (Fwrite(ohandle,pscan-pbuffer,pbuffer) != pscan-pbuffer) ioerror = 2; pscan = pbuffer; } *pscan = 0; } } /* end for (imagemask...) */ } /* end if (row) */ } /* end for (packlen...) */ /* some buffer remains unflushed... */ iolength = pscan - pbuffer; if (pmask != 0x80) iolength++; if (!ioerror && iolength > 0) if (Fwrite(ohandle,iolength,pbuffer) != iolength) ioerror = 2; /* write number of characters stored in file at beginning */ Fseek(olenpos,ohandle,0); if (!ioerror && Fwrite(ohandle,(long) sizeof(long),&packlen) != sizeof(long)) ioerror = 2; if (ioerror == 1) form_alert(1,"[3][Read error][Abort]"); else if (ioerror == 2) form_alert(1,"[3][Write error][Abort]"); /* close files, deallocate i/o buffers */ closefiles(ihandle,ohandle,ubuffer,pbuffer); /* keep interesting statistics */ packstats.pspeffic = (10000*packstats.psplen)/packstats.psulen; } /* end packtext */ /********** unpack a file **********/ unpacktext() { register unsigned int pmask; /* mask for selecting individual bits of packstream */ register int utindex; /* traverses unpack tree */ unsigned register char *pscan, /* grosser, 8-bit version of pmask */ *pend, /* end of pack buffer */ *uscan, /* unpacked character pointer */ *uend; /* end of unpack buffer */ unsigned char *pbuffer, /* memory buffer from packed file */ *ubuffer; /* buffer for unpack file */ int ihandle, /* input file handle */ ohandle, /* output file handle */ firstwrite, /* first write operation */ ioerror, /* did an i/o error occur? */ readtable, /* read code table from file? */ temp; long ilength, /* input file length */ iolength, /* i/o operation length */ packlen; /* input file character count */ /* get file handles and allocate i/o buffers */ if (!openfiles(&ihandle,&ohandle,&pbuffer,&ubuffer)) return; /* initialize error flag, first i/o operation flag, statistics and file length variables (packstats.psulen set later) */ packstats.psplen = 0; ioerror = 0; firstwrite = windopen[TXTWIND]; ilength = Fseek(0L,ihandle,2); Fseek(0L,ihandle,0); /* read packtable if requested */ readtable = (menudata[INCLCODES].ob_state & CHECKED) != 0; if (Fread(ihandle,(long) sizeof(int),&temp) == sizeof(int)) { if (temp != readtable) { readtable = temp; menu_icheck(menudata,INCLCODES,readtable); form_alert(1,"[1][Include tables flag|value changed.][ OK ]"); } } else ioerror = 1; if (readtable && !ioerror) if (Fread(ihandle,(long) sizeof(packtable),packtable) == sizeof(packtable)) { maketree(); for (temp = 0; temp < CODECOUNT; temp++) textprobs[temp] = 10000L/CODECOUNT; for (packstats.psteffic = 0, temp = 0; temp < CODECOUNT; temp++) packstats.psteffic += packtable[temp].ptlen; packstats.psteffic *= 1250; /* (effic*10000/8) */ } else ioerror = 1; /* read number of characters stored in file */ if (Fread(ihandle,(long) sizeof(long),&packlen) != sizeof(long)) ioerror = 1; /* adjust ilength from total file size to remaining file size */ ilength -= Fseek(0L,ihandle,1); /* read entire input file */ for (pscan = pend = pbuffer, pmask = 0x0, packstats.psulen = 0, uscan = ubuffer, uend = ubuffer + MAXTEXT; !ioerror && packlen > 0; packlen--, packstats.psulen++) { /* decode character */ utindex = 0; do { /* bounce around in packtree[][] until terminal node found */ if (pmask == 0) { /* go to next byte of packed buffer */ pmask = 0x80; packstats.psplen++; if (++pscan >= pend) { /* buffer end found: read more */ iolength = ilength > MAXTEXT ? MAXTEXT : ilength; ilength -= iolength; if (Fread(ihandle,iolength,pbuffer) != iolength) ioerror = 1; pscan = pbuffer; pend = pbuffer + iolength; } } utindex = packtree[utindex][(*pscan & pmask) != 0]; pmask >>= 1; /* go to next bit of packstream */ } while (utindex > 0); /* nonpositive utindex flags terminal node */ *uscan++ = -1 * utindex; /* save unpacked character in buffer */ if (uscan >= uend) { /* output buffer filled: flush it */ iolength = uscan-ubuffer; if (firstwrite) { /* save first one for public display */ firstwrite = 0; movmem(ubuffer,otext.trtext,(int) iolength); otext.trlcount = 1; otext.trlines[1] = otext.trtext + iolength; otext.trtopline = 0; tecalc(&otext); } if (Fwrite(ohandle,iolength,ubuffer) != iolength) ioerror = 2; uscan = ubuffer; } } /* end for (packlen...) */ /* input file processed, data remaining in output buffer */ iolength = uscan - ubuffer; if (!ioerror && iolength > 0) { if (firstwrite) { /* if first write, save for public display */ firstwrite = 0; movmem(ubuffer,otext.trtext,(int) iolength); otext.trlcount = 1; otext.trlines[1] = otext.trtext + iolength; otext.trtopline = 0; tecalc(&otext); } if (Fwrite(ohandle,iolength,ubuffer) != iolength) ioerror = 2; } if (ioerror == 1) form_alert(1,"[3][Read error][Abort]"); else if (ioerror == 2) form_alert(1,"[3][Write error][Abort]"); /* close files, deallocate i/o buffers */ closefiles(ihandle,ohandle,pbuffer,ubuffer); /* keep interesting statistics */ packstats.pspeffic = (10000*packstats.psplen)/packstats.psulen; } /* end unpacktext */ /************************************************************************/ /************************** Windowing Routines **************************/ /************************************************************************/ /********** turn a GEM window handle into its PACKTEXT index **********/ int getwindx(whandle) int whandle; { int ctr; for (ctr = 0; ctr < WINDCNT && window[ctr] != whandle; ctr++); return ctr; } /* end getwindx */ /********** take a requested total window size, make it real **********/ /* Value is nonzero iff window size is smaller or same in both directions, which means GEM won't take care of the redraw message */ int sizewindow(windx,wbx,wby,wbw,wbh) int windx,*wbx,*wby,*wbw,*wbh; { int oldw = windrect[windx][2], oldh = windrect[windx][3]; /* what does that work out to for a work area for our window? */ wind_calc(WC_WORK,windattrib[windx],*wbx,*wby,*wbw,*wbh, &windrect[windx][0],&windrect[windx][1], &windrect[windx][2],&windrect[windx][3]); if (windrect[windx][2] < 10*cellwidth) { /* too narrow */ windrect[windx][2] = 10*cellwidth; wind_calc(WC_BORDER,windattrib[windx], windrect[windx][0],windrect[windx][1], windrect[windx][2],windrect[windx][3], wbx,wby,wbw,wbh); } if (windrect[windx][3] < 6*cellheight) { /* too short */ windrect[windx][3] = 6*cellheight; wind_calc(WC_BORDER,windattrib[windx], windrect[windx][0],windrect[windx][1], windrect[windx][2],windrect[windx][3], wbx,wby,wbw,wbh); } return oldw >= windrect[windx][2] && oldh >= windrect[windx][3]; } /* end sizewindow */ /********** set window sliders **********/ setsliders(windx,vsize,vpos) int windx,vsize,vpos; { long newsize; if (windx == INFWIND || !windopen[windx]) return; if (vsize) { /* set vertical thumb size */ /* newsize is # of lines in window / total lines in displayed data */ newsize = (1000L * windrect[windx][3])/cellheight; if (windx == TXTWIND) if (otext.trlcount > 0) newsize /= otext.trlcount; else newsize = 1000L; else /* windx == CDEWIND */ newsize /= CODECOUNT; newsize = newsize > 1000L ? 1000L : newsize; wind_set(window[windx],WF_VSLSIZE,(int) newsize); } if (vpos) { /* set vertical thumb position */ /* newsize is index of top line / total lines in displayed data */ if (windx == TXTWIND) if (otext.trlcount > 0) newsize = (1000L * otext.trtopline)/otext.trlcount; else newsize = 0L; else newsize = (1000L * cwindtop)/CODECOUNT; wind_set(window[windx],WF_VSLIDE,(int) newsize); } } /* end setsliders */ /********** open a new window **********/ int openwindow(windx,firstime,wbx,wby,wbw,wbh) int windx,firstime,wbx,wby,wbw,wbh; { int dbx,dby,dbw,dbh; /* calculate windrect[][], then create as large as possible */ if (firstime) { sizewindow(windx,&wbx,&wby,&wbw,&wbh); wind_get(0,WF_WORKXYWH,&dbx,&dby,&dbw,&dbh); /* desktop window */ window[windx] = wind_create(windattrib[windx],dbx,dby,dbw,dbh); if (window[windx] < 0) return 0; windopen[windx] = 1; } else { wind_calc(WC_BORDER,windattrib[windx], windrect[windx][0],windrect[windx][1], windrect[windx][2],windrect[windx][3], &wbx,&wby,&wbw,&wbh); } switch (windx) { case TXTWIND : wind_set(window[TXTWIND],WF_NAME," Unpacked Text "); break; case INFWIND : wind_set(window[INFWIND],WF_NAME," Pack Data "); break; case CDEWIND : wind_set(window[CDEWIND],WF_NAME," Huffman Codes "); } /* end switch (windx) */ setsliders(windx,1,1); wind_open(window[windx],wbx,wby,wbw,wbh); return 1; } /* end openwindow */ /********** erase a window's contents **********/ clrwindow(windx) int windx; { /* make a rectangle equal to window contents, clipped to screen, then fill it. fill type is assumed background */ v_hide_c(schandle); ptsin[0] = (windrect[windx][0] > 0) ? windrect[windx][0] : 0; ptsin[1] = (windrect[windx][1] > 0) ? windrect[windx][1] : 0; ptsin[2] = windrect[windx][0] + windrect[windx][2] - 1; ptsin[2] = (ptsin[2] <= scrxmax) ? ptsin[2] : scrxmax; ptsin[3] = windrect[windx][1] + windrect[windx][3] - 1; ptsin[3] = (ptsin[3] <= scrymax) ? ptsin[3] : scrymax; vr_recfl(schandle,ptsin); v_show_c(schandle,1); } /* end clrwindow */ /********** show huffman codes generated in code window **********/ cwupdate() { int ctr,line, windbottom = windrect[CDEWIND][1] + windrect[CDEWIND][3]; char msg[80]; clrwindow(CDEWIND); v_hide_c(schandle); v_gtext(schandle, windrect[CDEWIND][0],windrect[CDEWIND][1]+cellheight, " Char Frequency Length/Code"); /* display each line of code table that fits in window */ for (ctr = cwindtop, line = windrect[CDEWIND][1] + 3*cellheight; line < windbottom && ctr < CODECOUNT; ctr++, line += cellheight) { makecstring(msg,ctr,1); v_gtext(schandle,windrect[CDEWIND][0],line,msg); } /* end for (ctr) */ /* add a line at the bottom to show theoretical packing efficiency */ line += cellheight; if (line <= windbottom) { strcpy(msg,"Efficiency rating "); longconc(msg,packstats.psteffic,4,0,0); v_gtext(schandle,windrect[CDEWIND][0],line,msg); } v_show_c(schandle,1); } /* end cwupdate */ /********** display info window (some stats) **********/ pwupdate() { char msg[40]; int x,y; clrwindow(INFWIND); v_hide_c(schandle); x = windrect[INFWIND][0] + cellwidth; y = windrect[INFWIND][1] + cellheight; strcpy(msg,"Unpacked length "); longconc(msg,packstats.psulen,0,0,0); v_gtext(schandle,x,y,msg); y += cellheight; strcpy(msg,"Packed length "); longconc(msg,packstats.psplen,0,0,0); v_gtext(schandle,x,y,msg); y += cellheight; strcpy(msg,"Packing efficiency "); longconc(msg,packstats.pspeffic,4,0,0); v_gtext(schandle,x,y,msg); y += cellheight; strcpy(msg,"Pack table efficiency "); longconc(msg,packstats.psteffic,4,0,0); v_gtext(schandle,x,y,msg); v_show_c(schandle,1); } /* end pwupdate */ /********** display any window **********/ /* windx is window index, drawmsg is a rectangle defining a subset of the window to be updated */ drawindow(windx,drawmsg) int windx,drawmsg[]; { int wx,wy,ww,wh; if (!windopen[windx]) return; wind_update(BEG_UPDATE); v_hide_c(schandle); /* update separately each rectangle in the list that defines the window */ wind_get(window[windx],WF_FIRSTXYWH,&wx,&wy,&ww,&wh); while (ww > 0 && wh > 0) { /* while valid rectangle */ /* calculate intersection of window rectangle and draw rectangle */ ptsin[0] = drawmsg[0] > wx ? drawmsg[0] : wx; ptsin[1] = drawmsg[1] > wy ? drawmsg[1] : wy; ptsin[2] = (drawmsg[0] + drawmsg[2] > wx + ww ? wx + ww : drawmsg[0] + drawmsg[2])-1; ptsin[3] = (drawmsg[1] + drawmsg[3] > wy + wh ? wy + wh : drawmsg[1] + drawmsg[3])-1; ptsin[2] = ptsin[2] > scrxmax ? scrxmax : ptsin[2]; ptsin[3] = ptsin[3] > scrymax ? scrymax : ptsin[3]; /* if intersection is not empty, clip and draw */ if (ptsin[2] > ptsin[0] && ptsin[3] > ptsin[1]) { vs_clip(schandle,1,ptsin); switch (windx) { case TXTWIND : teupdate(&otext); break; case INFWIND : pwupdate(); break; case CDEWIND : cwupdate(); } /* end switch (windx) */ } wind_get(window[windx],WF_NEXTXYWH,&wx,&wy,&ww,&wh); } /* clipping is normally off in this program */ vs_clip(schandle,0,ptsin); v_show_c(schandle,1); wind_update(END_UPDATE); } /* end drawindow */ /************************************************************************/ /************************ GEM Interface Handlers ************************/ /************************************************************************/ /********** wake up **********/ initialize() { int ctr,obctr, obval, wbx,wby,wbw,wbh; /* open the GEM workstation */ appl_init(); schandle = graf_handle(&cellwidth,&cellheight,&trash,&trash); for (ctr = 0; ctr < 10; ctr++) intin[ctr] = 1; intin[10] = 2; v_opnvwk(intin,&schandle,intout); scrxmax = intout[0]; scrymax = intout[1]; v_hide_c(schandle); graf_mouse(0,0); /* set up the screen: */ vsf_interior(schandle,0); /* fill mode is erase */ vst_alignment(schandle,0,3,&trash,&trash); /* text aligned @ bottom */ vswr_mode(schandle,1); /* writing mode is replace */ wind_get(0,WF_WORKXYWH,&wbx,&wby,&wbw,&wbh); /* desktop window */ /* object coordinate tweaking */ for (obctr = 0; oblist[obctr] != 0; obctr++) { ctr = 0; /* multiply each coordinate low byte by cell size, add high byte */ do { obval = oblist[obctr][ctr].ob_x; oblist[obctr][ctr].ob_x = cellwidth*(obval & 0xFF) + (obval >> 8); obval = oblist[obctr][ctr].ob_y; oblist[obctr][ctr].ob_y = cellheight*(obval & 0xFF) + (obval >> 8); obval = oblist[obctr][ctr].ob_width; oblist[obctr][ctr].ob_width = cellwidth*(obval & 0xFF) + (obval >> 8); obval = oblist[obctr][ctr].ob_height; oblist[obctr][ctr].ob_height = cellheight*(obval & 0xFF) + (obval >> 8); } while (!(oblist[obctr][ctr++].ob_flags & LASTOB)); } /* additional tweak for menu */ menudata[0].ob_width = scrxmax; menudata[menudata[0].ob_head].ob_width = scrxmax; /* set "windows" menu item strings */ for (ctr = 0; ctr < WINDCNT; ctr++) menudata[ctr+FSTWINDOW].ob_spec = (long) wmenustr[ctr+3]; menu_bar(menudata,1); /* calculate size of menubar */ vq_extnd(schandle,1,intout); menusize = ((scrxmax+1)/8)*intout[4]*wby; menusave = Malloc((long) menusize); if (menusave == 0) { form_alert(1,"[3][No memory!][Bad]"); return 0; } wby += 2; /* just some space between menu and windows */ wbh -= 2; /* define and open the three windows */ windattrib[TXTWIND] = NAME | CLOSER | MOVER | SIZER | UPARROW | DNARROW | VSLIDE; windattrib[CDEWIND] = windattrib[TXTWIND]; windattrib[INFWIND] = NAME | CLOSER | MOVER | SIZER; openwindow(TXTWIND,1,wbx,wby,wbw/2,wbh/2); openwindow(INFWIND,1,wbx+wbw/6,wby+wbh/6,wbw/2,wbh/2); openwindow(CDEWIND,1,wbx+wbw/3,wby+wbh/3,wbw/2,wbh/2); /* initialize appropriate variables */ setmem(packstats,sizeof(packstats),0); cwindtop = 0; /* set current path and file names */ filename[0] = 0; Dgetpath(pathname + 2,0); movmem("A:",pathname,2); pathname[0] += Dgetdrv(); strconc(pathname,"\\*.*"); /* finish constructing the default huffman code */ for (ctr = 0; ctr < CODECOUNT; ctr++) packtable[ctr].ptsymb = ctr; sortptable(); huffmans(); /* initialize text display area */ if (!tenew(&otext,TXTWIND)) { form_alert(1,"[3][Insufficient memory|for text buffer.][Abort]"); return 0; } v_show_c(schandle,0); return 1; } /* end initialize */ /********** run a dialog; return which object was chosen **********/ int dodialog(thedialog) OBJECT *thedialog; { int dbox[4], /* dialog position and size */ window, /* handle for window in which dialog appears */ wbx,wby,wbw,wbh, /* window size and position */ ctr, obj; /* object causing exit from dialog */ /* draw the dialog inside a window, if possible */ form_center(thedialog,&dbox[0],&dbox[1],&dbox[2],&dbox[3]); wind_calc(WC_BORDER,0,dbox[0],dbox[1],dbox[2],dbox[3], &wbx,&wby,&wbw,&wbh); window = wind_create(0,wbx,wby,wbw,wbh); if (window >= 0) wind_open(window,wbx,wby,wbw,wbh); form_dial(FMD_START,dbox[0],dbox[1],dbox[2],dbox[3]); form_dial(FMD_GROW,0,0,2,2,dbox[0],dbox[1],dbox[2],dbox[3]); objc_draw(thedialog,0,2,dbox[0],dbox[1],dbox[2],dbox[3]); /* find first edit object if any, open it, run the dialog */ for (obj = 0; !(thedialog[obj].ob_flags & (LASTOB | EDITABLE)); obj++); if (!(thedialog[obj].ob_flags & EDITABLE)) obj = 0; obj = form_do(thedialog,obj); thedialog[obj].ob_state &= ~SELECTED; /* "erase" it: does this do anything? */ form_dial(FMD_SHRINK,0,0,2,2,dbox[0],dbox[1],dbox[2],dbox[3]); form_dial(FMD_FINISH,dbox[0],dbox[1],dbox[2],dbox[3]); /* now really erase it, as well as possible */ if (window >= 0) { wind_close(window); wind_delete(window); } else for (ctr = 0; ctr < WINDCNT; ctr++) drawindow(ctr,dbox); return obj; } /* end dodialog */ /********** run the blasted file selector box **********/ getfname(path,file,prompt) char *path,*file,*prompt; { int ok; char *slider, /* slide up and down path and file name */ *marker, /* marks points of interest found by slider */ *screen, /* location of screen in memory */ realname[60]; /* temporary to build filename */ /* replace menu bar with prompt */ screen = Physbase(); v_hide_c(schandle); movmem(screen,menusave,menusize); /* copy menu bar to safekeeping */ setmem(screen,menusize,0); /* erase it */ vst_effects(schandle,1); /* bold text */ vqt_extent(schandle,prompt,ptsout); /* get length of prompt */ v_gtext(schandle,(scrxmax-(ptsout[2]-ptsout[0]))/2,cellheight,prompt); vst_effects(schandle,0); /* back to normal text */ v_show_c(schandle,1); /* if file includes a pathname, remove it ("path" assumed to have copy) */ slider = file; while (*slider++); marker = slider; while (*--slider != '\\' && slider >= file); if (slider >= file) movmem(slider+1,file,(int) (marker-slider)); /* get path and filename from human */ fsel_input(path,file,&ok); /* glom path and filename together in filename */ strcpy(realname,path); slider = realname; while (*slider++); while (*--slider != '\\' && slider >= realname); strcpy(slider+1,file); strcpy(file,realname); /* return menu bar */ v_hide_c(schandle); movmem(menusave,screen,menusize); v_show_c(schandle,1); return ok; } /* end getfname */ /************ menu item was chosen ************/ int domenus(menu,item) int menu, /* which menu was chosen */ item; { /* the actual item within the menu */ int tuesday; tuesday = 1; switch (menu) { case DESKMENU : dodialog(glorybox); break; case FILEMENU : switch(item) { case PACKFILE : graf_mouse(2,0); /* busy symbol */ packtext(); if (menudata[INCLCODES].ob_state & CHECKED) { /* new code tables */ setsliders(CDEWIND,1,1); drawindow(CDEWIND,windrect[CDEWIND]); } drawindow(TXTWIND,windrect[TXTWIND]); drawindow(INFWIND,windrect[INFWIND]); graf_mouse(0,0); break; case UNPACKFILE : graf_mouse(2,0); unpacktext(); if (menudata[INCLCODES].ob_state & CHECKED) { /* new code tables */ setsliders(CDEWIND,1,1); drawindow(CDEWIND,windrect[CDEWIND]); } drawindow(TXTWIND,windrect[TXTWIND]); drawindow(INFWIND,windrect[INFWIND]); graf_mouse(0,0); break; case SAVECODES : savecodes(); break; case LOADCODES : loadcodes(); drawindow(CDEWIND,windrect[CDEWIND]); drawindow(INFWIND,windrect[INFWIND]); break; case INCLCODES : menudata[INCLCODES].ob_state ^= CHECKED; break; case QUIT : tuesday = 0; } /* end PROGMENU switch (item) */ break; case HUFFMENU : switch (item) { case GENERATE : if (loadfreqs()) { setsliders(CDEWIND,1,1); drawindow(CDEWIND,windrect[CDEWIND]); drawindow(INFWIND,windrect[INFWIND]); } break; case PRINTCODES : printcodes(); } /* end HUFFMENU switch (item) */ break; case WINDMENU : item -= FSTWINDOW; windopen[item] = !windopen[item]; if (windopen[item]) { openwindow(item,0,0,0,0,0); setsliders(item,1,1); drawindow(item,windrect[item]); } else wind_close(window[item]); menudata[item+FSTWINDOW].ob_spec = (long) wmenustr[item + (windopen[item] ? 3 : 0)]; } /* end switch (menu) */ menu_tnormal(menudata,menu,1); return tuesday; } /* end domenus */ /********* handle the window events ***********/ int dowindows() { int wx,wy,ww,wh, /* window position and size */ windx, /* window index */ misc, tuesday; tuesday = 1; windx = getwindx(message[3]); switch (message[0]) { case MN_SELECTED : tuesday = domenus(message[3],message[4]); break; case WM_REDRAW: /* redraw some part of the window */ if (windx < WINDCNT) drawindow(windx,message+4); break; case WM_TOPPED : /* put this window on top */ wind_set(message[3],WF_TOP,message[3]); break; case WM_CLOSED : /* close some window */ wind_close(message[3]); windopen[windx] = 0; menudata[windx+FSTWINDOW].ob_spec = (long) wmenustr[windx]; break; case WM_ARROWED : switch (message[4]) { case 0 : /* page up */ if (windx == TXTWIND) otext.trtopline -= windrect[TXTWIND][3]/cellheight; else /* CDEWIND */ cwindtop -= windrect[CDEWIND][3]/cellheight - 2; break; case 1 : /* page down */ if (windx == TXTWIND) otext.trtopline += windrect[TXTWIND][3]/cellheight; else cwindtop += windrect[CDEWIND][3]/cellheight - 2; break; case 2 : /* scroll up */ if (windx == TXTWIND) otext.trtopline--; else cwindtop--; break; case 3 : /* scroll down */ if (windx == TXTWIND) otext.trtopline++; else cwindtop++; } /* end switch (which arrow) */ if (windx == TXTWIND) { if (otext.trtopline >= otext.trlcount) otext.trtopline = otext.trlcount - 1; if (otext.trtopline < 0) otext.trtopline = 0; } else { if (cwindtop > CODECOUNT) cwindtop = CODECOUNT; if (cwindtop < 0) cwindtop = 0; } drawindow(windx,windrect[windx]); setsliders(windx,0,1); break; case WM_VSLID : if (windx == TXTWIND) { wh = otext.trlcount > 0 ? otext.trlcount - 1 : 0; wy = (wh * (long) message[4])/1000; otext.trtopline = wy > wh ? wh : wy; } else { wy = (CODECOUNT * (long) message[4])/1000; cwindtop = wy > CODECOUNT ? CODECOUNT : wy; } drawindow(windx,windrect[windx]); setsliders(windx,0,1); break; case WM_SIZED : wx = message[4]; wy = message[5]; ww = message[6]; wh = message[7]; misc = sizewindow(windx,&wx,&wy,&ww,&wh); wind_set(window[windx],WF_CURRXYWH,wx,wy,ww,wh); if (windx == TXTWIND) tecalc(&otext); setsliders(windx,1,1); if (misc && windx == TXTWIND) drawindow(windx,windrect[windx]); break; case WM_MOVED : sizewindow(windx, &message[4],&message[5],&message[6],&message[7]); wind_set(message[3],WF_CURRXYWH, message[4],message[5],message[6],message[7]); } /* end of switch */ return tuesday; } /* end dowindows */ /************************************************************************/ /******************************** Program *******************************/ /************************************************************************/ /********** **********/ main() { int tuesday; /* continue until... */ tuesday = initialize(); while (tuesday) { evnt_mesag(message); tuesday = dowindows(); } /* end main loop */ for (tuesday = 0; tuesday < WINDCNT; tuesday++) { if (windopen[tuesday]) wind_close(window[tuesday]); wind_delete(window[tuesday]); } v_clsvwk(schandle); appl_exit(); } /* end main */ `K *O.|k*m - ЭЭм// ??<JNA N?/<NA"/0<NBNuNVH *n(n `fJL0N^NuNVH *n(n `JfS`fJL0N^NuNVH *n(n >.c`0SGJ@n``%0SGJ@nJL0N^NuNVH*n>. <.`0SGJ@nJL N^NuNVJ mB@`p=@gD Jngp0`p =@JnoJnoRnJng0.HЎм-@` A-H nBS/./< /< /. NE`P/NE P/ . м0 _SnfS n./< /. NE`P-@ J o мeJng мdS n-JnoD`S n0Snm мe мdS n.Jng&`S0."n мe`2p ".$Լ𒂐=@>RW//.NP./.NlXN^NuNV. ?<HN@T/ n nBh nBh n1n .p?<HN@T/ n!_ nJg nJfD nJg n.?<IN@T nJg n.?<IN@TB@`4Bn` n h2n"n Rn nmp`N^NuNV.l/<l/U?.?9y`NC 0.`N^NuNV-n `S n  g . b . f .`` . R-@`S n  f . b n .fp`pHѮ . c .` . `N^NuNVH n h"n2i-P n0( Hмrd @=hBG n h"n n*P n h"n2i (P`BF`H>N@nn  ge޼nn  fJdD  fR`".S0G"n")/0NX*@RG n h2G e|RG n1G n h2G n>( `SG0G"n") 0b n1G>?< n?( N$lXJL0N^NuNV n> N(>y`NA n0( Hмrd @=P n0( Hмrd @=h n0("n2) HҼrd"A2)HuA=@ n0( nl n0( `0.=@ n=h`0nRH"n") 0"n"i4n"=@>/0n"n")/0NP0.HЎм-@`S ."Ҽc n  o n  oR nB09un.?.?.?9y`NA"\Rn0.nm&>?9y`ND8TN^NuNV-|=|Bn`R`/</.NE`P-@Rn0n"<L| 0m0.2nu@Rn nmN^NuNVJnnByu =|=n`~0nSH"<u00R@2nu3@0n"<u0@2nSIu)AA=@0nu2.0(h1@Rn nm|=|=n`B0n"<u00r4nu*BaAe =n`Rn nm0.`N^NuNVBn`,0nn<00nn<1|Rn n mBnBn`"Bnp2nu)ASA`=@`0n"<u00nfB@`p=@0n2nn< Pn Rn0n2nn<00n2nn<=P nnx0nu(fB@`p=@0n"<u0@2n4nn<20n2nnN =@llBn0nuS(0nuJ(gLJng60n"<u0@2nSIu)AAe>N J@m0nuR(>N Rn0.|mdBWN N BmBn`D0n"<L|/00n"<u0@/NE PѹmRn nm/</9mNE`P#mN^NuNV=|`(Bn`Rn0.nl(0n"<L| 02nL|"l0.nl0nL|-P0.n@>0.R@HмL|/0.HмL|/NP0nL| >/0.Hмu/NP0.n@>0.R@Hмu/0.Hмu/NP>0.Hмu//NPRn nmN^NuNVH Bn`*0.2nu0nL|BRn nmB=|BW?.B?<BN@P` o < ` . -@ . ./.?.?<?N@PgBn.V?<NGT`n*n(n`R@|d(@ @L|'R`Bn.W ?<NGT`ReJ n6BW?.B?<BN@PBn`6/.0n"<L|/0NE`P/0nL| Rn nmJngN N 0.`JL0N^NuNV.WH/<y$/<nN6PJ@fB@`BW/<y$?<=N@\=@l.Wc?<NGTB@`. ?<HN@T-@Jf*.W?<NGT>?<>N@TB@`\>?.B?<BN@P-@./.?.N \=@.?<IN@T>?<>N@T0.`N^NuNV.W/<y$/<nN6PJ@gBW/<y$?<=N@\=@m,>?<>N@T.W?<NGT|gBW/<y$?<?<>N@TN^NuNV.XL/<y$/<nN6PJ@gBW/<y$?<=N@\=@l.Xq?<NGT`.u/<?.?<?N@Pg.X?<NGT`>?<>N@TN Bn`0nL| 'Rn nmBmBn`(0n"<u0@ѹmRn nm/</9mNE P#mN^NuNV0n "<u0@=@Jngp`p =@0nB(> ?./N\./.NJXJngFJnf.X/.NlX`$.X/.NlX0.2n@`~ n m2 n~n(.X/.NlX0.2n@`D.X/.NlXBW?<Bg0n//.N .X/.NlX./.NlXBW?<?<0n "<L|/0/.N ./.NlXBW?<Bg0n "<u0@//.N .X/.NlX=|`0n "<u00r4.aAg.X/.NlX`H0n "<u0@nc.X/.NlX`.X/.NlXSnJnlzN^NuNV-n` nH>?<N@TR nJf> ?<N@T> ?<N@TN^NuNVBW?<2NFT>N@=@f.X?<NGT|gJngBn=|6`d n6m.YN=|BW?./N\.N n5f> ?<N@TRnRn nm.YK/NJXBWBg?</9m/N .NN^NuNV.Y_/<y$/<nN6PJ@fB@`/.Bg/<y$?<=N@P _0l.Yq?<NGTB@`.Y/<y$/<nN6PJ@fB@`r/. Bg/<y$?<=N@P _0mF n >?<>N@T.Y?<NGT|f n>?<>N@TB@`/. Bg/<y$?<?<>N@TB@`. ?<HN@T/ n . ?<HN@T/ n nJg nJfv nJg n.?<IN@T nJg n.?<IN@T.Y?<NGT n >?<>N@T n>?<>N@TB@`p`N^NuNV.?<IN@T. ?<IN@T> ?<>N@T>?<>N@TN^NuNVH9RfB@`p=@./Q//NX J@g.BmBn=yt>?.B?<BN@P-@BW?.B?<BN@PJng8./.?.N \J@f./.?.?.NTP`./<?.?<@N@Pf:Jng..u/<?.?<@N@Pg=|`=|>?.B?<BN@P-@Jnf0./<?.?<@N@Pg=|B*nB(n << .-@&@Bm`e o < ` .-@ .⑮./.?.?<?N@Pg=|&n .Ю-@JngLBn .>/9t/.NP3t 9tЮ"yt#@Byt.tNBG`RG|d"0 @"<u0@f־|dRz0 @"<u0@S@m`|0 @"<u002Ag 0NJFfJRm<<R b4. /?.?<@N@P" g=|*nBMJEfRmRJnfJnTeL -@|gRJnf0Jo(./.?.?<@N@Pg=|BW?./.?<BN@PJnf0./<?.?<@N@Pg=| nf.Z?<NGT` nf.Z6?<NGT./.?.?.NTP/9m/<'/9mNE P/NE`P#mJL8N^NuNVH./Q//NX J@g\BmBn=yt>?.B?<BN@P-@BW?.B?<BN@P9RfB@`p=@./<?.?<?N@Pf@0.ng0=n>?</<PNH\.ZN?<NGT`=|JngJnf.u/<?.?<?N@PfN Bn`0nL| 'Rn nmBmBn`(0n"<u0@ѹmRn nm/</9mNE P#m`=|./<?.?<?N@Pg=|>?.B?<BN@P(n*LBGBm&n .м -@`HBFJGfn><RmR bZ o < ` .-@ ../.?.?<?N@Pg=|*n(n0FA4Bf`2|n<<OJFn^0D@He -@JngLBn .>/9t/.NP3t 9tЮ"yt#@Byt.tN./.?.?<@N@Pg=|&nSRmJnf Jn -@JnfJozJngLBn .>/9t/.NP3t 9tЮ"yt#@Byt.tN./.?.?<@N@Pg=| nf.Z|?<NGT` nf.Z?<NGT./.?.?.NTP/9m/<'/9mNE P/NE`P#mJL8N^NuNVBn`Rn nl0n"<y00nf0.`N^NuNV0.Hмrd @=h0.Hмrd @=h0.Hмrd.\0.Hмrd/X0.Hмrd/T0.Hмrd/ n? n? n? n ?0n"<t?0?<NJ0.H @"<rd0029m Al09m 2.HҼrd"A3@./././. 0.H @"<rd?00.H @"<rd?00.H @"<rd?00.H @"<rd?00n"<t?0BgNJ0.H @"<rd0029uAl09u2.HҼrd"A3@./././. 0.H @"<rd?00.H @"<rd?00.H @"<rd?00.H @"<rd?00n"<t?0BgNJ0.H @"<rd00nn0.H @"<rd00noB@`p`N^NuNV ng0n"<tJpgzJn g09uH//<0.H @"<rd00H/NE P/NE`P-@Jnf6Jyto 09tH//.NE`P-@` -|`/</.NE`P-@ o <` .-@ .>?<0n"<y?0NJRXJn gJnfFJyto409tH//<0yt/NE P/NE`P-@`B`,/</<0yt/NE P/NE`P-@ .>?< 0n"<y?0NJRXN^NuNVJn g./// ?.N!.Q/]/Y/U?<BgNJ>?.?.?.0n"<t?0NIXP?0ny00nyJPlB@`V0nt0`./// 0.H @"<rd?00.H @"<rd?00.H @"<rd?00.H @"<rd?00n"<t?0BgNJ0.`V.Z?<?9yNJRX`N.Z?<?9y NJRX`2.Z?<?9y"NJRX`J@g|g|g`>?<?.N$lX>?.?.?. 0n"<y?0NIPp`N^NuNV>y`NA0.Hмrd @JPo0.H @"<rd00`B@3r|0.Hмrd @Jho0.H @"<rd00`B@3r~0.H @"<rd002.HҼrd"A2)AS@3r09rytn 09r`09t3r0.H @"<rd002.HҼrd"A2)AS@3r09rytn 09r`09t3r.r|?9y`NCxT>?9y`ND8TN^NuNV09rvyrz=@>N(>y`NA.Z?9rv09uW?9rt?9y`NA"\=yt09uyrv=@`H>?./N\.?.?9rt?9y`NA"\Rn09un0.nl nm09un0.nnZ.Z/NJXBWBg?</9m/N .?.?9rt?9y`NA"\>?9y`ND8TN^NuNV>N(>y`NA09rlym=@09rnyu=@.[ /NJXBWBgBg/9m/N .?.?.?9y`NA"\09un.[/NJXBWBgBg/9m/N .?.?.?9y`NA"\09un.[+/NJXBWBg?</9m/N .?.?.?9y`NA"\09un.[?/NJXBWBg?</9m/N .?.?.?9y`NA"\>?9y`ND8TN^NuNV0n"<tJpgP>NJ>y`NA.Q/]/Y/U?< 0n"<y?0NJ` n 0no n 0`0.3r| n 0(no n 0(`0.3r~ n 0"n 2)A2.nAo0.n` n 0"n 2)AS@3r n 0("n 2)A2.nAo0.n` n 0("n 2)AS@3r09ryto 09t`09r3r09ryto 09t`09r3r09ryr|oj09ryr~oZ.r|?<?9y`NCX0.`&.tN`*N*` N)h`J@gذ|g|g`.Q/]/Y/U?< 0n"<y?0NJJno Jnn..r|Bg?9y`NCX>?9y`ND8TBWNJN^NuNVNFh.l/<l/<u/<mNH4 3y`Bn`0nk0Rn n m3k.l/<y`/<kNAP3lt3lt>y`NABWBgNHvTBW?9y`NCT.l/<l?<Bg?9y`NDl >?9y`N@T.///Q?<BgNJBn`Bn0n"|T< p2.=h0.|m2.AA2nT<"Q4.3@0n"|T< p2.=h0.|u2.AA2nT<"Q4.3@0n"|T< p2.=h0.|m2.AA2nT<"Q4.3@0n"|T< p2.=h0.|u2.AA2nT<"Q4.3@0. @2nT<"00| RnJ@g~Rn0nT/<PNHX.l?<?9y`NB8X09tR@Hl3t09tHR.?<HN@T#tJtf.[V?<NGTB@`TnUn3t3tt3+t0.H>0.H??.?.?<BgN& 0.H>0.H?0.H?0.W0.H?0.W?<?<N& 0.H>0.H?0.H?0.W0.H?0.W?<?<N& BW?< |mp? QNBytB9y$BW/<n?<GN@\>/<n/<[kNP>N@9nn.[n/<nNlXBn`0.2nuRn nmN N BW/<tNXJ@f.[s?<NGTB@`BW?9y`ND8Tp`N^NuNV.U/Y/]/Q/.NG.///?.?.?.?.BgBgNJ>?.?.?.BgNIXP=@Jnm>?.?.?.?.NIP>?.?.?.BgNG:P>?.?.?.?<?<BgBg?<NG:>?.?.?.?<Bg/.NIBn`Rn n2.00|(g0.Ю @( fBn>/.NGX=@0.Ю @h >?.?.?.?<?<BgBg?<NG:>?.?.?.?<NG:PJnm>NI>NI`&Bn`.Q?.N,zTRn nm0.`N^NuNV>N@-@>y`NA>t/9t/.NPBW?9t/.N\>?9y`NDT.s|/.?9y`NB\.?9u09t29sys|AH??9y`NA"\BW?9y`NDT>?9y`ND8T-n ` nHRJf-n`S n \g . d . e .>/. /.RNP.U/. /.NHP./NJXA-H` nHRJf`S n \g мc. /.RNJX./. NJX>y`NA>t/./9tNP>?9y`ND8T0.`N^NuNV=|0.`.SN4`0. `>BW?<NHvTN9Rg(>?<?<N$lX.rt?<N,zT.rdBgN,zT.rl?<N,zTBWBgNHvT`BW?<NHvTN 9Rg(>?<?<N$lX.rt?<N,zT.rdBgN,zT.rl?<N,zTBWBgNHvT`hNt`^Nr.rt?<N,zT.rl?<N,zT`0 yR`$Bn`||b@0@TH PN`0. `TNrJ@g:>?<?<N$lX.rt?<N,zT.rl?<N,zT`NR`|g|g``n 0n "<tJpgB@`p2n t20n "<tJpgPBWBgBgBgBg?. N& >?<?. N$lX0. Hмrd.?. N,zT`0n "<y>NI0. |мP @2n tJQg 2|` P|!Q `&|g,|g4|g|g`>?./<PNH\0.`N^NuNV=|>mN!=@09m`>m?9mN8T=@` nl.m?.N,zT`>m?< ?9mNJRX`>mNI0ntBP0.|мP @2nP|!Q `l09m`Jnf09rjHuyt`09rzHuU@yt`Jnf09rjHuyt`09rzHuU@yt`VJnf Syt`Syt`:Jnf Ryt`Ryt`J@gP|g|g|g`Jnf409tytm09tS@3tJytlByt`& yto 3tJytlByt0.Hмrd.?.N,zT>Bg?.N$lX` Jnf`Jyto09tS@`B@=@0ym/0n/NE PH=@0.no 0.`0.3t`209mHခH=@ no 0<`0.3t0.Hмrd.?.N,zT>Bg?.N$lX`B=ym=ym=ym=ym.Q/]/Y/U?.N!=@>?.?.?.?<0n"<y?0NJR Jnf.tN>?<?.N$lXJng&Jnf0.Hмrd.?.N,zT`v.m/<m/<m/<m?.N!>m?9m?9m?9m?<?9mNJR `| |b@0@Th PN0.`N^NuNVN.=@`.mNFN;=@JnfBn`F0n"<tJpg0n"<y>NI0n"<y>NIRn nm>y`N@NFN^Nu#kNN/9kNu#kNM/9kNu#kNA/9kNuNV3 k3 tByt3u3uND09lN^NuNV3etBytByu3uNDN^NuNV3 r|3 r~Bn nH|2nk2RRnJ@f3t3tSn3u3uNDN^NuNV3{tBytByu3uNDN^NuNV#k#k .мZ#k3dtByt3 u n 3uND n 0u#kk#lk#s|k#r|kN^NuNV#kk#r|k# k . мZ#k3 k3ftByt3u3uND#lk#s|kN^NuNV-|k n H"n2R TJ@f#k3ttByt .kāHS@3u3uND#s|kN^NuNV. H3k3utByt3u3uND n 0s| n0s n0s09lN^NuNV# k3rt3tByu3uND#r|kN^NuNV# k3 k3t3t3u3uND#r|kN^NuNV3 k3tByt3u3uND09lN^NuNV3 k3ztByt3u3uNDN^NuNV3 k3 k3'tByt3u3uND n0l n0lN^NuNV3 k3jtByt3u3uND09lN^Nu#tk"<kpsNBNuNVBBJlDRBJ lD RB0. -@0.2. An=@ .gDN^NuNVH?BCB..,. f#k <`hlDRCJlDRCn8fzB`0l :HGH`xe`Jge`|fD#k D`#k JLN^NuNV3t0.|HмK -@=|` nH2nt2RRn nm.tN>B@09tN^NuNV#tm#t|m#tm#tm#um#ybm#mt> aF3ttpN^NuNV>a*pN^NuNV#u>NEN^NuNV3t3 t>NEN^NuNV#u3 t>2NEN^NuNV3t3 t3 t3t3t3t3t3t3t>3NEN^NuNV3t# u>4NEN^NuNV#u>6NE n 0t n0t n0t n0tB@09tN^NuNV#u# u>ZNE n0tB@09tN^NuNV>MNE n0t n 0t n0t n0tB@09tN^NuNV3t# u>NNEN^NuNV#u3 t>NEN^NuNV#u3 t3t>NEN^NuNV#u3 t3t>!NEN^NuNV#u3 t3t3t3t3t3t>*NEN^NuNV3t3 t3 t3t3t>dNEN^NuNV3t3 t3 t3t3t>eNEN^NuNV3t>fNEN^NuNV3t>gNEN^NuNV3t3 t>hNE n 0t n0t n0t n0tB@09tN^NuNV3t3 t3 t3t3t3t>iNEN^NuNV3t>kNEN^NuNV3t3 t3 t3t3t3t>lNE n0t n0t n0t n 0tB@09tN^Nu /Sd   (uC:.-y O TTTTUU-  U3 U: UA  UI -  US Ud Uy UzU{U|U}U~UUUUUUUV VV3 VI VJ VK!# VLVhVV'VPS89<99:9:9;?????????<< <<?<?=>?v Open Text Window Open Pack Data Window Open Code Window Close Text Window Close Pack Data Window Close Code Window Desk File Codes Windows About PackText-------------------- Pack a File Unpack a File Save Huffman Codes Load Huffman Codes------------------------- Include Codes in File------------------------- Quit Generate Huffman Codes Print Huffman CodesPackText uses Huffman Codesto compress and decompresstext files.Copyright 1986 Daniel MatejkaOK[3][Unpacktree overflowed.|Don't attempt to unpack|anything.][Not OK][3][Read error][Abort][3][File contains characters|not allowed in tables][Abort]Select File to be Analyzed[3][Can't find that file.][ OK ][3][No memory free!][ Ack ]Select File In Which to Save Codes[2][That file already exists][Overwrite|Stop][3][Can't create that file][ Abort ][3][Write error][Abort][1][Code table written][ OK ]Select File From Which to Load Codes[3][Can't open that file][ Abort ][3][Read error:|Code tables are damaged.][Abort]Null chr()/10 [1][Please turn on|the printer][ OK | Abort ] Char Frequency Length/Code Efficiency rating Select Input File[3][Can't find that file][ Abort ]Select Output File[2][That file already exists][Overwrite|Stop][3][Can't create that file][ Abort ][3][No memory for packing!][ Abort ][3][Read error][Abort][3][Write error][Abort][1][Include tables flag|value changed.][ OK ][3][Read error][Abort][3][Write error][Abort] Unpacked Text Pack Data Huffman Codes Char Frequency Length/CodeEfficiency rating Unpacked length Packed length Packing efficiency Pack table efficiency [3][No memory!][Bad]A:\*.*[3][Insufficient memory|for text buffer.][Abort].j 84< HLV~"T4& :L2"." $*  8 6*B < &            @ 0      4  .      8 $2 "0*:H8  $.$"(&V$&"    4  ,, "&&(FD<  B      0(& &  & 6  &:   $  <"" 8    ,              ,&BF     8      * """"(&     ,PP    *@((&R@  (      fP  &      "  *  :        .     * *  *          $    zf  $                     nXH0000 . ON.. NNLESSN9QRTXT sMT LESSON9 TXT rMoSNAPSHOTIMG ZC THis month's QR is unusual. It contains no functions. Instead, I have listed each of the STRUCTS detailed in the article. Explanations are in the text, however. I have also listed any 'enumerated types' and bitflags like ob_state. GEM OBJECT { WORD ob_next; WORD ob_head; WORD ob_tail; UWORD ob_type; UWORD ob_flags; UWORD ob_state; VOID *ob_spec; WORD ob_x; WORD ob_y; WORD ob_width; WORD ob_height; } OBJECT; TEDINFO STRUCTURE { char *te_ptext; char *te_ptmplt; char *te_pvalid; WORD te_font; WORD te_fontid; WORD te_just; WORD te_color; WORD te_fontsize; WORD te_thickness; WORD te_txtlen; WORD te_tmplen; }TEDINFO; IMAGE BITBLK { WORD *bi_pdata; WORD bi_wb; WORD bi_hl; WORD bi_x; WORD bi_y; WORD bi_color; }BITBLK; MONOCHROME ICON ICONBLK { WORD *ib_pmask; WORD *ib_pdata; char *ptext; WORD ib_char; WORD ib_xchar; WORD ib_ychar; WORD ib_xicon; WORD ib_yicon; WORD ib_wicon; WORD ib_hicon; WORD ib_xtext; WORD ib_ytext; WORD ib_wtext; WORD ib_htext; }ICONBLK; COLOUR ICON STRUCTURES { ICONBLK monblk; CICON *mainlist; }CICON_BLK; typedef struct cicon_data { WORD numplanes; WORD *col_data; WORD *col_mask; WORD *sel_data; WORD *sel_mask; struct cicon_data *next; }CICON; PROGDEF STRUCTURES { WORD (*ab_code) (PARMBLOCK *); LONG ab_parm; }APPBLK: { OBJECT *tree; WORD pb_obj; WORD pb_prevstate; WORD pb_currstate; WORD pb_x; WORD pb_y; WORD pb_w; WORD pb_h; WORD pb_xc; WORD pb_yc; WORD pb_wc; WORD pb_hc; LONG pb_parm; } OB_TYPE VALUES 20 G_BOX 21 G_TEXT 22 G_BOXTEXT 23 G_IMAGE 24 G_PROGDEF 25 G_IBOX 26 G_BUTTON 27 G_BOXCHAR 28 G_STRING 29 G_FTEXT 30 G_FBOXTEXT 31 G_ICON 32 G_TITLE 33 G_CICON OB_FLAG bits 0 SELECTABLE 1 DEFAULT 2 EXIT 3 EDITABLE 4 RBUTTON 5 LASTOB 6 TOUCHEXIT 7 HIDETREE 8 INDIRECT 9 FL3DIND 10 FL3DACT 11 SUBMENU OB_STATE bits 0 SELECTED 1 CROSSED 2 CHECKED 3 DISABLED 4 OUTLINED 5 SHADOWED GEM PROGRAMMING by Jonathan White ARTICLE 9 Hello and welcome to this month's GEM article. This time we are going to start into our look at GEM resources, one of the more complex but most useful parts of GEM. This month I am going to talk a little about the different parts of a resource (NOTE: a resource and a resource FILE are not the same thing. A resource file can and usually does contain several resources). But what exactly IS a resource? The answer is mostly anything. The file selector is a resource. Menus are resources. And the GEM desktop is a resource. So is any dialogue box you use when you use a GEM program. Basically, a resource is a collection of boxes, lines and pieces of text (all these are called OBJECTS) that prompt the user for some sort of input. Much beyond that, and you are getting too specific to cover them all. So, a typical dialogue box is a resource. It is a also a collection of objects. That is a resource is constructed from the objects. Take a typical dialogue box.. We can see that it is a box, which contains several smaller boxes, which themselves contain other things. Some of them are marked out from the others by having thicker lines or by being inverted. This also helps to show us how a typical dialogue box is organised. Resources are drawn from the back objects to the front objects. That way things never overlap where they shouldn't. The first thing to be drawn is the main box. This is known as the ROOT object. After that (below it in the 'tree'). Are several objects. Each of these (the two boxes on the left BUT NOT the contents of the bottom one, the two 'exit' buttons, the two 'edit' lines and the 'dialogue 2' box) are all drawn at the same time and are all one step down the list from the root box. The root box is known as the PARENT of all these objects, and they are SIBLINGS, since they all have the same 'parent'. They are also the CHILDREN of the root box. Below this level we have the two 'radio' boxes. Each objects PARENT is the object that completely surrounds it, so the two RADIO boxes and the EXIT boxes are NOT siblings, as they do not have the same parent. All these relationships will become important later, as we look at the particulars of how a resource - otherwise called an object tree - is organised. If you want an idea of how it is organised, imagine a directory on a disk, say C:. This has the top directory (C:\) - the ROOT directory. All the directories and files in the root directory are the CHILDREN of C:\ and the SIBLINGS of each other. These directories might have files in them and each file (or directory) in that directory is the child of that directory and are siblings of each other and so on down the 'directory tree'. For now we will not concern ourselves too greatly with organising objects, as that will all become clear soon. For now, we shall look at the data objects containing several C STRUCTS. All objects have a common main structure, defined as the OBJECT type, in one of your C compilers GEM include files (you should check to find which one). It has the following structure { WORD ob_next; WORD ob_head; WORD ob_tail; UWORD ob_type; UWORD ob_flags; UWORD ob_state; VOID *ob_spec; WORD ob_x; WORD ob_y; WORD ob_width; WORD ob_height; } OBJECT; Some of these are self explanatory - ob_x,ob_y,ob_width and ob_height define the position and size of the object on the screen. The rest need a closer inspection. ob_next, ob_head and ob_tail are used to define the tree structure of the dialog. Each object in the dialog is given a particular number, starting from the root object of 0 on downwards, and going down and right to find the next one. ob_next gives the number of the next object to draw after this one. Therefore, siblings have numbers in sequence, unless one of the siblings has children, in which case they get the next number, and so on down. A typical tree might look like this.. 0(root) | | ----------------- | | | 1 2 5 | --------- | | 3 4 These numbers are used in the fields ob_next, ob_head and ob_tail. ob_next points to the next object in the tree that is a sibling. The final sibling of any 'level' has an ob_next that points to his parent. The root object requires an ob_next of -1, which signifies it as the root, because by definition it can have no siblings. If an object has children, the ob_head contains the number of its first child, and ob_tail, the last. If an object has no children, their values are -1. Therefore, our tree has values as follows... object ob_next ob_head ob_tail 0 -1 1 5 1 2 -1 -1 2 3 3 4 3 4 -1 -1 4 2 -1 -1 5 0 -1 -1 These values allow the system to draw the tree in the correct order, back to front, so that objects are properly visible. Basically, if ob_head contains other than -1, draw that number object, otherwise draw ob_next. ob_tail tells it where to go back to to carry on when it has drawn one 'branch' of the tree. NOTE: by fooling around with these values and using special objects (which we will come to later) many special effects can be produced. Although, obviously, unless you are REALLY sure of what you are doing, the effects are likely to be disastrous. ob_type defines the type of object with the dialog, surprise surprise. The possible values are as follows.. ob_type value Name 20 G_BOX (An opaque box, possibly with a border) 21 G_TEXT (A formatted text string - colour, font size..) 22 G_BOXTEXT (G_TEXT inside a G_BOX) 23 G_IMAGE (A monochrome bitmap image) 24 G_PROGDEF (An object with a userdefined drawing routine) 25 G_IBOX (An 'invisible box. Used to group objects) 26 G_BUTTON (A string with a box around it) 27 G_BOXCHAR (A single letter in a G_BOX) 28 G_STRING (A string of system font text, unformatted) 29 G_FTEXT (A user editable string of formatted text) 30 G_FBOXTEXT (A G_FTEXT in a G_BOX) 31 G_ICON (A monochrome icon (different from a G_IMAGE)) 32 G_TITLE (A special object form used for menu titles) 33 G_CICON (A NEW AES colour icon) Each of these objects are modified by three other fields- ob_flags, ob_state and the information pointed to by *ob_spec. The first two are the same for any object, so we can look at them first. Both are a set of binary flags which define certain properties of the object.. ob_flags.. BIT NAME FUNCTION 0 SELECTABLE Clicking on this object with the mouse inverts it 1 DEFAULT When drawn, this object has a bold border. If the return key is pressed, this object is automatically selected, and the dialog exits. No more than one object in any dialog can have this attribute set. 2 EXIT Clicking on this object caused the dialog to exit. It also has a bold border. An object which is both DEFAULT and EXIT will be double bold. For example, in the standard file selector, both OK and CANCEL are 'EXIT', with OK also being 'DEFAULT' 3 EDITABLE This is usually used for text, allowing the user to change it. In the example, the path and the area right of 'SELECTION' are editable. 4 RBUTTON This object is a radio button. If several objects at the same level have RBUTTON on, selecting one of them deselects the others. Note they also need 'selectable' set. RBUTTONS are usually set as siblings by making them the children of a small G_IBOX. 5 LASTOB The object is the last in its particular tree. You can use this bit to temporarily remove part of the tree from view. 6 TOUCHEXIT Similar to the EXIT flag, this has one important difference. With a normal EXIT object the dialog always quits when the button is clicked over it AND RELEASED (try it and see). With touchexit, it quits immediately the mouse button is pressed. This allows for rapid changes in the dialog box, and for draggable objects, by using the data from the dialog then quickly redrawing it. For example, the up and down arrows and vbar in the standard file selector are touchexit. When one is pressed, the list of files in the box is recalculated and redrawn instantaneously, allowing the user to scroll through lists. 7 HIDETREE This object and all its children are not to be shown. This allows for 'expanding' or changing dialog boxes. The easiest example of this is the copy / format dialog in the desktop. Depending on which of the buttons are selected (touchexit selectable rbuttons, yes? You see, it's easy when you know how..) a part of the dialog is hidden and the other unhidden. In this case they DO overlap, but as long as only one is visble at once, this is not a problem. 8 INDIRECT This one allows for more data to be stored than the STRUCT could normally hold. Normally, the ob_spec field holds a struct of data. If INDIRECT is set, it instead holds a POINTER to a struct of data. 9 FL3DIND 10 FL3DACT These help define the object's appearance in terms of the NEW AES 3D dialog boxes, seen on the Falcon and the MultiTOS desktop. THe object is shaded according to the following plan.. 9 10 Action 0 1 This object is a 3D actuator. Suitable for EXIT objects 1 0 This object is a 3D indicator. Suitable for radio / toggle buttons 1 1 This object is part of the 3D background. If its colour is set to white and fill 0, it will inherit the default 3D background colour. 11 SUBMENU This object has a submenu associated with it. These are also part of the NEW AES, and are somewhat beyond the scope of a beginners article. ob_state functions in a similar way. It too represents a set of binary flags which show the current appearance of the object, as follows.. BIT NAME FUNCTION 0 SELECTED The object is highlighted -inverted usually, unless new AES, when its 'highlighted' appearance depends upon its type. 1 CROSSED For box objects, an X is drawn in the box. Note a touchexit box is required so a mouseclick can be responded to by setting this option. 2 CHECKED For menu items, on=having a tick mark next to it. There is a specific function ( menu_icheck() ) to toggle this bit. 3 DISABLED Greyed out by masking off every other bit. THe AES will not allow the user to click on it. NOTE: A disabled object can still be selected by return if it is DEFAULT. 4 OUTLINED An outline is drawn round a box object. A truly invisible box would be a G_IBOX with a fill of 0 and OUTLINED set to 0. 5 SHADOWED A 'drop shadow' of the object is drawn. Between these two flag maps, a large part of the appearance of the object can be set. Other parts of the parameters for the object are set by the values in the ob_spec field. Since these are specific for each object type, we will now go on to discuss them in detail. G_BOX, G_IBOX and G_BOXCHAR (the box objects) all share the same parameters. Their size is fixed by members of the OBJECT structure, but further attributes are set by ob_spec. In this case, the field directly contains (rather than points to) the data. The two WORDS are split as follows.. The lower WORD contains information as to the colour of the object as follows.. BITS Function 0-3 Interior colour (0-15) 4-6 Interior fill 0 Background colour (IP_HOLLOW) 1-6 Dithered (IP_1PATT to IP_6PATT) 7 Foreground (IP_SOLID) 7 Writing mode 0=transparent, 1=overwrite 8-11 Border colour (0-15) 12-15 Text colour (0-15) The lower byte of the upper word is a signed byte representing the thickness of the border. -127 to -1 Outside thickness away from border in pixels 0 No border 1 to 128 Inside thickness away from edge inwards in pixels The high byte of the high word is used only by G_BOXCHAR and holds the ASCII value of the character to be shown. G_STRING, G_BUTTON and G_TITLE (the text objects) all share ob_spec parameters too. In this case, ob_spec contains a pointer to the text string to be displayed. This is in standard C format. The next group (the formatted text objects) includes G_TEXT, G_BOXTEXT, G_FTEXT and G_FBOXTEXT. In these cases, ob_spec points to a defined GEM structure, called a TEDINFO structure.. { char *te_ptext; (pointer to the actual text string) char *te_ptmplt; (pointer to the format template) char *te_pvalid; (pointer to the validation string) WORD te_font; (font info) WORD te_fontid; (which font to use) WORD te_just; (font justification) WORD te_color; (color information - as boxes) WORD te_fontsize; (font size to use) WORD te_thickness; (border thickness of boxed objects) WORD te_txtlen; (length of text string) WORD te_tmplen; (length of template string) }TEDINFO; Taking the font information first, the first consideration is te_font. This can have the following values.. BIT Name Function 0 GDOS_PROP Use SpeedoGDOS font 1 GDOS_MONO Use SpeedoGDOS font, force monospacing 2 GDOS_BITM Use GDOS bitmap font 3 IBM Use standard system font 5 SMALL use small system font Note that values of 1 and 2 will be ignored if the AES version is <4.1 and or SpeedoGDOS is not installed. 0 will be ignored if the AES version < 4.0 and SpeedoGDOS is not installed. In these cases, 3 will be used. If Speedo fonts CAN be used, te_fontid specifies which font is used and te_fontsize specifies how big. Otherwise these too are ignored. te_hjust has a value of 0 selects left justified text, 1 specified right and 2 centered. The values of te_txtlen and te_tmplen MUST include the terminating character (ASCII 0). The most complicated parts of the structure are the first three. te_ptext points to the actual string initially shown. A special case is if the first character is @, then the entire string is presumed to be filled wth spaces. te_pvalid tells the system what characters are allowed in the string. for each character in te_ptext, there must be one in t_pvalid, defined as follows te_pvalid char Character allowed 9 numbers only (0-9) a lower and upper case alphanumerics and space n digits, alphabetic (upper and lower), and space p all chars valid in a filepath A uppercase only alphabetics and space N uppercase alphabetics, digits and space F all valid filename characters, including wildcards but NOT \ P all valid filepath characters (including wildcards and \ ) X anything whatsoever Thus you can limit the name of a file output only to characters that are a valid filename etc. te_ptmplt points to a string which defines the static (uneditable) characters in the string. This can, in fact be larger than the editable string and the system will align it correctly. Any character being overwritten by an editable one must be defined as a '_'. We can look at several examples below A filename with the extension not as a wildcard) te_ptext *********** te_pvalid FFFFFFFFppp te_ptmplt FILENAME: ________.___ would appear as 'FILENAME: ********.***' a bank sorting code, two digits, followed by a minus sign, followed by four digits. te_ptext 111111 te_pvalid 999999 te_ptmplt CODE __-____ would appear as 'CODE 11-1111' a telephone number, a four letter code in brackets, followed three digits, then a minus, then three digits te_ptext 1234567890 te_pvalid 9999999999 te_ptmplt Phone: (____)___-____ would appear as 'Phone: (1234)567-890' Obviously, a lot of the time you would fill te_ptext with spaces or underline characters. These are the most basic means a user has to enter data into a dialog box. The next type of object is the monochrome image, or G_IMAGE. This is distinct from a monochrome icon in that it is not meant to be selectable. This allows its structure to be simpler. In this case, the value of ob_spec is again indirect, and it is a pointer to a structure known as a BITBLK, which has the following definition.. { WORD *bi_pdata; // pointer to bit image data WORD bi_wb; // bit image width (in bytes - must be even) WORD bi_hl; // height of image in lines WORD bi_x; // X offset from start of data block WORD bi_y; // Y offset from start of data block WORD bi_color; // Image foreground color }BITBLK; Some of these (b_color, wb, hl, and pdata) are clear. The two that require explanation are bi_x and bi_y. These, along with bi_wb and bi_hl allow you to 'pick' an icon form out of the pdata area, which might contain several images in one bitmap. The pdata map itself is a simple bit array, which must be WORD aligned. Each 1 bit is drawn in the foreground colour. The next most sophisticated object is similar, the G_ICON. This is different from G_IMAGE in that it is meant to be selectable and has a particular behaviour when it is. The ob_spec field of a G_ICON type points to a data structure called an ICONBLK. This is defined as follows.. { WORD *ib_pmask; // pointer to the image mask data WORD *ib_pdata; // " " " " data char *ptext; // pointer to the object's text string WORD ib_char; // low byte = ASCII character drawn on icon // high byte = foreground and background colours WORD ib_xchar; // x offset of that character WORD ib_ychar; // y offset of that character WORD ib_xicon; // X coordinate of the icon (in image data) WORD ib_yicon; // y coordinate of the icon (in image data) WORD ib_wicon; // width of the icon (pixels) WORD ib_hicon; // height of the icon (in pixels) WORD ib_xtext; // the x offset of the text string (from icon top) WORD ib_ytext; // the y offset " " " " (from icon left) WORD ib_wtext; // the width of the text in pixels WORD ib_htext; // the height of the text in pixels }ICONBLK; Most of this will be set up by the resource editor you use. The main thing to note is the way the AES draws the icon. First, it takes the bitmap of the mask, and colours pixels which are '1' in the mask to the background color. It leaves the '0' pixels alone. Then it colours all the pixels that are '1' in the data bitmap to the foreground colour. When the icon is selected, it uses the data for the mask and vice versa. Note that both bitmaps must be a multiple of 16 pixels wide. However, it is important to know this stuff in case you come across a situation where your program would wish to modify the icon as it was running. Personally, in these cases, I tend to have two ICONS and swap between them, but it's not as memory efficient, nor can you do some of the geewizz stuff (I once saw a program that had a milkbottle filling up as a progress indicator for a download process by realtime altering the mask. Very nice, but the time that bit took to figure out might have been better spent fixing some serious bugs in the program.). The new form of colour icon, seen in the new falcon and multiTOS desktops (and available to any programs which use them - and I think Geneva and MagiC / EASE use them too) are known as G_CICONS. In this case, the ob_spec field points to a CICON_BLK structure. This has the following form.. { ICONBLK monblk; // as above - the mono form of the icon CICON *mainlist; // see below }CICON_BLK; The CICON structure is a structure which defines a set of images for various colour scemes. Although, I have yet to see any 256 or truecolour icons, in theory such things are possible. They would possibly lead to VERY large .RSC files though. For those of you who haven't seen them, they have the distinction from standard icons that the selected form can be an entirely different icon from the normal form. They have the following format.. typedef struct cicon_data { WORD numplanes; //number of bitplanes in this form WORD *col_data; // icon image data in device independant form WORD *col_mask; // icon mask data; same format WORD *sel_data; // selected form image data WORD *sel_mask; // selected form mask data struct cicon_data *next;// pointer to next icon (i.e same icon, // different number of colour planes }CICON; Thus to look its best in any colour resolution a G_CICON would need 4, 16, 256, 16 bit and 24 bit forms. An AWFUL lot of data for one icon. Note that if the *sel items = NULL, the icon will be shaded (dithered with midgrey) when selected. As far as I know, the only resource editor that handles this form of icon properly is InterFace distributed by Compo. Hisoft WERCS crashes when you load a file with them in, and the chances of it being updated any time soon is virtually nil (Hisoft seem to have more or less stopped developing their own software and have become a licensing agency..) and I can't see anyone putting the effort into a shareware product with a proper multicolour icon editor. A pity, because they do enhance the look of a program greatly. Perhaps if MagiC becomes the standard OS across all ST's they will gain in popularity... The last, and potentially most complicated resource type is the userdefined resource, or G_PROGDEF. For these, the system basically hands a section of the resource over to your program to draw and maintain. This can be anything from a font preview box, to a different form of radio button, to a realtime scrolling message.. In this case, ob_spec points to a structure called an APPBLK.. { WORD (*ab_code) (PARMBLOCK *); LONG ab_parm; }APPBLK: Basically, ab_code is a pointer to a function which redraws the section of the resource. The parameters of this function MUST be a PARMBLOCK structure. ab_parm is anything you wish. { OBJECT *tree; // pointer to the tree that contains this object; WORD pb_obj; // the objects index in the tree WORD pb_prevstate; // the objects old state field WORD pb_currstate; // the objects current state WORD pb_x; WORD pb_y; WORD pb_w; WORD pb_h; // the current size and position of the object WORD pb_xc; WORD pb_yc; WORD pb_wc; WORD pb_hc; // the objects clipping rectangle LONG pb_parm; // holds a copy of the ab_parm field of the APPBLK } Basically, the user routine will do something like this... user_draw (pb) PARMBLK *pb { Parse_parmblk(pb); do_redraw; return(0); // your routine should ALWAYS return 0 } If you are doing this, you should be aware that the AES is calling the function so you should avoid using long lists of parameters or recursion within it and you should NEVER call AES functions within it. All this is a bit advanced for us, I know, but it fits here if anywhere. If you don't understand it, don't use it is the best advise I can give. To be honest, documentation on this type is scarce enough as it is, so that I couldn't skate over it in case you could find no other source. Well, that's the structure of GEM resources dealt with. The question you are probably asking yourself now is WHY? If a decent resource editor will do all this for me, why do I have to know it. Well, apart from the fact that you are a conscientious and diligent programmer who wants to know as much about GEM as possible (just like me ;-) ), the main way you get information on the actions a user takes when the resource is displayed is by the changes in these structures. When a user clicks or edits an object, its structures and data flags are changed accordingly. The only way we can detect what those changes are is to examine the structures after the dialog has quit. We will go on to look at this next time, when we will look at displaying dialogs and retrieving responses from them. ;ttXIMG                                a  a  a  a  a  a  a  a  a  a  a  a          a  a  a  a ~`|`||~<a ~`|`||~<a ~`|`||~<a ~`|`||~<a ``f`ff`f ``f`ff`f ``f`ff`f ``f`ff`f |`f`|f|f |`f`|f|f |`f`|f|f |`f`|f|f ``f`ff`f ``f`ff`f ``f`ff`f ``f`ff`f ``f`ff`f ``f`ff`f ``f`ff`f ``f`ff`f `~|~||~< `~|~||~< `~|~||~< `~|~||~<                         a a a a a` a` a` a` a` a` a` a`     a a a a a a a a a a a a a a a a                             $~~ $~~ $~~ $~~ `8 `8 `8 `8 $`><<8<<<<8<<<<8<<<<8<< <8  <8  <8  <8 <<8<<<<8<<<<8<<<<8<< ~<8  ~<8  ~<8  ~<8 < f<>< f<>< f<>< fFff fFff fFff fFff |>ff |>ff |>ff |>ff ffff ffff ffff ffff ffff8 ffff8 ffff8 ffff8 ffffp ffffp ffffp ffffp f>><~ f>><~ f>><~ f>><~                                      ``  ``  ``  ``  a`  a`  a`  a`  aaf``  aaf``  aaf``  aaf``  af`  af`  af`  af`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`  aaf`          `  `  `  `  `  `  `  `                             " " " " $$$$.  ON .. GFA_TIPS  ON AUTOZEST ON%.  ON ..  ON TRIX TXT _M[ THE "ATARI ST VIRUSKILLER" PROGRAMMING TRICKS (AND TIPS) by Richard Karsmakers Over the last three years, I have been programming my "Atari ST Virus Killer" (previously known under the name "Virus Destruction Utility"). In those years, the program has evolved from a little thing to check disks for the "Signum" virus into a fairly extensive and very effective tool in the battle against viruses. I have learned programming properly in that time, too (well... not all too properly, but who cares about that?), and therefore I would like to share some of the source code of my virus killer with you, hoping to give you some interesting tips & tricks of how to program in GfA Basic. All examples quoted here are from GfA Basic 3, though adaptation to GfA Basic 2 shouldn't prove to be too difficult (but, then again, it may). ----------------- CHECK HOW MUCH MEMORY IS LEFT ----------------- Some of you may think this is done with the help of the FRE(0) command of GfA. Nothing is less true, however! FRE(0) supplies you with the amount of bytes free for programming in GfA Basic itself. Once the program has been compiled and you want to really see what amount of memory is available without actually wanting to get the figure of free Basic work space, you can use the following Gemdos call: a%=(GEMDOS(72,L:-1)) The amount of memory that's truly left will afterwards be in a% (where else had you expected it?!). ------- CHECKING WHETHER OR NOT A DISK IS WRITE-PROTECTED ------- It is very difficult to find out whether a disk in drive A or B is write-protected or not. The Operating System does not offer any functions for this, and therefore people often resort to using 'illegal' (not officially documented) system variables that are likely to change with every TOS version. I used to do exactly the same, and so did Stefan (hence the reason why ST NEWS often didn't work on STE computers - and we're not even talking about the TT!). When I was in Norway last winter, Lord HackBear gave me a better routine. It accessed the FC (Floppy Controller) directly, and seemed to work smoothly. Yet it didn't in special cases. So I had my colleague Michael Bittner at Thalion software look it over. He made it better, but it turned out not to work with two disk drives attached (not properly, at least). So, finally, another colleague by the name of Chris Jungen solved the problem and hence I can now offer you a routine that definitely works on all ST systems - although I have not tested it on the TT and it may not work there... FUNCTION wrpr(crd%) SDPOKE &H43E,-1 !Floppy operations off ~XBIOS(29,NOT (2*(crd%+1))) !Select drive SDPOKE &HFF8606,&H80 !FDC-statusregister select buf%=DPEEK(&HFF8604) !FDC-statusregister read ~XBIOS(30,2*(crd%+1)) !Deselect drive SDPOKE &H43E,0 !Enable floppy operations buf%=(buf% AND 64)/64 !Isolate WP-bit RETURN buf% !Return WP bit as function value ENDFUNC The function can be used as follows, where a% contains the device number (0=A, 1=B): IF @wrpr(a%)=1 ALERT 1,"DISK WRITE PROTECTED!",1,"SHIT",b% ELSE ALERT 1,"EVERYTHING OK!",1,"YEAH",b% ENDIF ---------------------- WAITING FOR A KEY ------------------------ In most programs, it is often required for the program to just wait. Wait until a key is pressed, or until a mouse fire button is pressed, or either. The following routine does this in quite a perfect, fool-proof way: PROCEDURE waitkey LOCAL taste$ LPOKE XBIOS(14,1)+6,0 !Clear keyboard buffer taste$="" DO taste$=INKEY$ EXIT IF MOUSEK OR taste$<>"" LOOP RETURN Since the routine only has to wait, nothing is done with the result. This result, however, is located in the variable 'taste$' so you can do whatever you want with it. If, however, you want to use the result after getting back from this subroutine, you have to get rid of the line that reads 'LOCAL taste$'. --------------------- INITIALISING A DRIVE ---------------------- When scanning through a drive or partition (or, worse, through several different floppy disks), it is possible that one of the following things happens: A) The system still 'thinks' it's got the old disk in the drive. B) A Gemdos 'file not found' or 'out of memory' error occurs. These are both 'bugs' in the Operating System, and I am lead to believe that at least B) has been discarded in TOS 1.6 (possibly even 1.4). The way to solve this is reading the directory off a disk. GEM now recognises that a new disk is there, and all internal buffers are empties like they should. However, you have to initialise the proper drive - and you don't want any stupid filenames all over the screen, do you? So what you have to do is put the drive number in 'devno%' (A=0, etc.), and then use: buf$=CHR$(65+devno%)+":SHIT.QXY" The somewhat unusual search template makes sure that no filenames occur on the screen. ----------------------- FORMATTING A DISK ----------------------- The option to format a disk is very useful to include in a program that writes files to disk; the user must be able to quickly format a disk without having to leave the program if he doesn't have some readily formatted disks handy. The following is the routine that is implemented in the "Atari ST Virus Killer". Is formats a disk single-sided and has been optimised to do just that. Flexibility is gone, and since I was too lazy to make it flexible again (sorry, folks!), I just added some comments here and there. Nothing more. PROCEDURE format LOCAL e%,t%,d% !Something to do ALERT 2,"ARE YOU SURE YOU|WANT TO FORMAT|FLOPPY IN DRIVE A|SINGLE SIDED?!",2,"YES|NO",d% IF d%=1 ;Yeah....format! screen$=SPACE$(10000) !Reserve space for format buffer e%=0 !Error variable t%=0 !First track to format DO SHOWM !See note #1 ' See note #2 e%=XBIOS(10,L:V:screen$,L:0,0,9,t%,0,1,L:&H87654321,0) IF e% !Error occurred! ALERT 1,"FORMAT ERROR!!",1,"AHEM",d% EXIT IF e% ENDIF INC t% !No error....increment track! EXIT IF t%>79 !All tracks formatted LOOP IF e%=0 !DO-LOOP left without error ' This installs the BPB in the bootsector ' Check contents of BPB in any good ST book ("ST Intern") screen$=STRING$(6,0)+MKL$(XBIOS(17))+CHR$(0)+MKI$(2)+CHR$(2) screen$=screen$+MKI$(&H100)+CHR$(2)+CHR$(112)+CHR$(0) screen$=screen$+CHR$(208)+CHR$(2)+CHR$(&HF9) screen$=screen$+MKI$(1280)+MKI$(&H900)+MKI$(256) screen$=screen$+MKI$(0)+STRING$(512,0) SHOWM !See Note #1 ' This writes the bootsector VOID XBIOS(9,L:V:screen$,L:0,0,1,0,0,1) VOID BIOS(7,0) !Get BPB ' Default (empty) FAT contents screen$=MKL$(&HF9FFFF00)+STRING$(508,0) SHOWM !See Note #1 ' Write both FATs VOID BIOS(4,1,L:V:screen$,1,1,0) VOID BIOS(4,1,L:V:screen$,1,6,0) ALERT 1,"THIS DISK NOW HAS|"+STR$(DFREE(1))+" BYTES FREE!",1,"OK",d% ENDIF ENDIF RETURN Note #1 Gemdos has a tendency to disable the mouse whenever doing disk I/O. Should an error occur during the disk I/O that causes a GEM alert box to be displayed, you will then find it very hard to select "OK" or "Cancel". This solution seems to work. Note #2 This is the actual Xbios format command. The parameters are the following: e%=XBIOS(10,L:V:screen$,L:0,0,9,t%,0,1,L:&H87654321,0) | | | | | | | | | | | | | | | | | | | Virgin word | | | | | | | | Magic longword | | | | | | | Interleave | | | | | | Side (here, only side 0) | | | | | Track number (here, 0-79) | | | | Sectors per track | | | Device (here, only A) | | Filler (any value...doesn't matter) | The pointer to the format buffer Xbios function call #10 The 'virgin word' is the word with which the track will be filled after formatting. The 'magic longword' is necessary to make the routine format at all. The 'interleave' is the sequence in which the sectors are written on a track (different interleaves with different numbers of sectors per track result in different data transfer speeds). --------- SCANNING A DRIVE/PARTITION FOR ALL ITS FILES ---------- This routine is the heart of the linkvirus scan routine, and originally written by Stefan. There were a couple of bugs and, let's say, 'unwanted skips', in the routine, so therefore I did some additional coding on it. Except for that bit of 'further coding', it's a straight port of a harddisk backup program that Stefan wrote an article about aeons ago (in ST NEWS, of course). PROCEDURE do_backup buf$=CHR$(65+devno%)+":SHIT.YXQ" !See above FILES buf$ ! " " LOCAL e$,x$,fold%,fspec$,x%,curr_path$,currdrive% ' curr_path$=DIR$(0) !Store current path IF curr_path$="" !If nothing curr_path$="\" !Root ENDIF currdrive%=GEMDOS(&H19)+1 !Current drive fold$(0)=RIGHT$(path$,LEN(path$)-2) !Get first folder name CHDRIVE ASC(LEFT$(path$))-64 !Change to it fold%=0 e$=SPACE$(13) !File name buffer ' CLS PRINT "Now checking drive..." PRINT "Press Escape to abort!" REPEAT CHDIR fold$(fold%) !First folder...and more x%=LEN(DIR$(0))+3 PRINT AT(2,7);DIR$(0);"\" !Print first bit of name ' DEC fold% !Dec folder fspec$=nomo$+"."+ext$ !Search template SHOWM !See above (Note #1) e%=GEMDOS(&H4E,L:V:fspec$,-1) !Gemdos Sfirst WHILE e%=0 !No error... ' The following checks if filename is FOLDER or VOLUME IF (PEEK(GEMDOS(&H2F)+21) AND 16)=0 AND (PEEK(GEMDOS(&H2F)+21) AND 8)=0 x$=SPACE$(13) !Clear name BMOVE GEMDOS(&H2F)+30,V:x$,13 !DTA address PRINT AT(x%,7);e$ !Print name PRINT AT(x%,7);x$;SPACE$(45) !And more... ' Here, you can DO something with the file if you want ' Insert your own routines! ENDIF BMOVE V:e$,GEMDOS(&H2F)+30,13 !Get from DTA SHOWM e%=GEMDOS(&H4F) !Gemdos Snext IF ASC(INKEY$)=27 !Escape pressed? EDIT ;Yes....quit! ENDIF WEND ' fspec$="*.*"+CHR$(0) !Search template SHOWM e%=GEMDOS(&H4E,L:V:fspec$,-1) !Sfirst WHILE e%=0 IF (PEEK(GEMDOS(&H2F)+21) AND 16) x$=SPACE$(13) BMOVE GEMDOS(&H2F)+30,V:x$,13 IF x$<>"."+CHR$(0)+SPACE$(11) AND x$<>".." +CHR$(0)+SPACE$(10) !Special folder files? INC fold% fold$(fold%)=DIR$(0)+"\"+x$ ENDIF ENDIF BMOVE V:e$,GEMDOS(&H2F)+30,13 SHOWM e%=GEMDOS(&H4F) !Snext IF ASC(INKEY$)=27 EDIT ENDIF WEND UNTIL fol<0 CHDRIVE currdrive% !Set back old drive CHDIR curr_path$ !Set back old dir RETURN ---------------------- COOKIE JAR HANDLING ---------------------- On TOS 1.6 and up, Atari implemented something called 'The Cookie Jar'. This is a reserved area in memory where certain values represent certain things. It was included for the STE and TT's sakes, so that program would have ways of getting to know which hardware they were addressing. Of course, Atari totally neglected to document this feature, but after many hours of searching and months of experiencing (and glancing over an issue of German "ST Magazine") I can now offer you some info about it. At address $5A0 (an official system variable that will not be changed any more - but then again you never know with Atari), there will be a zero or a longword pointer. If you have a zero there, this means that: A) Someone shoved a magazine into your system. B) You have a TOS version lower than 1.6, or the pre-version of TOS 1.6. If you find a longword pointer, this will be the address to find the Cookie Jar. The Cookie Jar is, strictly speaking, a collection of 32-bit values, of which two belong together each time. The first one is usually a value representing some kind of ASCII string, and the second is the actual value. Usually, this is another address. ASCII strings starting with an "_" are of Atari and should never be used by other people rather than Atari! The last Cookie is always a longword zero followed by the maximum number of cookies that can be used (only a specific amount of memory is reserved for Cookies, and you should not use more unless you want to install it all yourself again and expand it - but that's too much to tell here). That's basically all there is to know about the Cookie Jar. Its use is simple: Apart from other programs just getting parameters from it, it can also specify addresses of variable locations that can then be used by other programs. Some of the officially documented Atari Cookies are the following. First follows the longword ASCII string, and then the value(s): _CPU This is not hard to imagine. It specifies which processor is present in the system. It can be 0, 10, 20 or 30 for 68000, 68010, 68020 and 68030 respectively. _VDO Version number of the Videohardware. This is actually represented by two words. The first word is the spot in front of the command; the second the one after. 0,0 ST 1,0 STE 2.0 TT _SND A bit table that tells programs which sound possibilities they have. Only two of these 32 bits are used - but let's hope that this shall not last long (idle hopes...). Bit 0 YM soundchip (ST and STE) Bit 1 Stereo DMA sound (STE) _MCH Described the machine you use. Here, also, we're talking about two words. 0,0 260 ST, 520 ST(F)(M), 1040 ST(F)(M) 1,0 MEGA ST (Difference: Real Time Clock) 2,0 STE 3,0 TT _SWI Value of configuration switches, if present. Don't ask me what this is supposed to mean. I don't know (neither do any mortals outside of Atari Corp., I suspect). _FRB Since the TT's "Fast RAM" is not usable for DMA transfers, the BIOS of that computer creates a 64 Kb buffer area in memory of which the address can be found here. Well...that's all there is to say, really. Now, let's head for the source bit. PROCEDURE cookie LOCAL x% CLS IF LPEEK(&H5A0)<>0 !Cookie jar present! x%=LPEEK(&H5A0) !Cookie jar address DO ' This prints the hex cookie address, the cookie identification and the ' cookie value after each other PRINT HEX$(x%);" -- ";MKL$(LPEEK(x%));" -- "; HEX$(LPEEK(x%+4)) ADD x%,8 EXIT IF LPEEK(x%)=0 LOOP ELSE PRINT "No Cookie Jar present (yet)!" ENDIF RETURN ---------------- CREATING A CLEARER FILESELECTOR ---------------- In TOS versions lower than 1.4, the fileselector didn't allow any optional parameters to be supplied (like "SELECT FILE TO LOAD"). In TOS 1.4 and up, using GfA Basic 3, you can specify this using an optional string parameter of the FILESELECT command. FILESELECT "FILE TO LOAD","\*.*","MYFILE.FIL",lo$ If you belong to the enormous groups of people 'blessed' with lower TOS versions, you can use the following routine (medium and high res only). It just puts a bit above the fileselector box before it is called. This may be at the wrong place for certain alternative fileselector boxes! It is being called as follows: @fileselectmooi("FILE TO LOAD") FILESELECT "\*.*","",lo$ And this is the routine: PROCEDURE fileselectmooi(a$) DEFFILL 0,1 IF XBIOS(4)=1 !Medium res PBOX 0,0,319,40 BOX 0,0,320,26 BOX 0,3,319,23 BOX 1,4,318,22 DEFFILL 1,1 PBOX 2,5,317,21 GRAPHMODE 3 DEFTEXT ,,,6 TEXT 25,18,a$ ELSE !Other res (here: High only!) PBOX 157,20,482,60 BOX 157,20,482,54 BOX 160,23,479,51 BOX 161,24,478,50 DEFFILL 1,1 PBOX 162,25,477,49 GRAPHMODE 3 DEFTEXT ,,,13 TEXT 184,43,a$ ENDIF GRAPHMODE 1 RETURN -------------- CHECKING WHICH DRIVES ARE CONNECTED -------------- This routine has obvious uses. The only problem is that I haven't actually found ways of really checking for disk B. The system seems to think it's always present. Tough shit. Another problem is that I don't really grasp my own code any more. All I know is that, in the end, you get a variable called att$ in which you'll get e.g. "A|B|C|D|Cancel". Further, in ndr% you'll find the actual number of drives attached. I know you may find this a bit shit, but I am simply too lazy to find out what I've done again (it may not even work all on its own when not surrounded by the rest of the virus killer program). Just regard it as some kind of extra. It's always better to have something than nothing. PROCEDURE drijfbitz ' * Get drive bits and determine which drives are attached ' ad%=&H4C2 !Drivebits system variable ac$=BIN$(LPEEK(ad%)) !Get active drives buf%=LEN(ac$) IF buf%>2 !RAM-and/or harddisks attached norm!=FALSE ELSE !Only drive A or A+B attached norm!=TRUE ENDIF ' ERASE dr%() DIM dr%(buf%) !Dim an array for that y%=0 x%=0 DO IF MID$(ac$,buf%-x%,1)="1" !Drive present? IF x%>1 !Harddisk only! SHOWM IF BIOS(7,x%)>0 !Get bpb address, if>0, drive is REALLY present dr%(y%)=65+x% !Put letter in array INC y% !Next array element ENDIF ELSE dr%(y%)=65+x% !Put letter in array INC y% !Next array element ENDIF ENDIF INC x% !Next bin$ element EXIT IF x%>buf% LOOP att$="" x%=0 DO EXIT IF dr%(x%)=0 att$=att$+CHR$(dr%(x%))+"|" INC x% LOOP att$=att$+"Cancel" ndr%=x%-1 !Number of drives attached minus one RETURN -------------------- OPENING ALL THE BORDERS -------------------- Well, well. I suppose you're dying to know this, aren't you? OK. It's very simple. You load in an assembler and use the source featured in ST NEWS Volume 5 Issue 1. Hack a bit...assemble... execute...and you're there! Alas, this is slightly difficult to do in GfA Basic. If someone knows how to do it properly (full screen, that is) in 100% GfA Basic (maybe some sync scrolling on top of that), he can call me and get my ST system for free. --------------------- REVERSE TEXT DISPLAY ---------------------- To make a certain word or line of text stand out among the rest, it can be useful to reverse its display mode - i.e. the text becomes white and the block around the characters becomes black. You can use the following routines to do this: PROCEDURE on !Reverse on PRINT CHR$(27);"p"; RETURN PROCEDURE off !Reverse off IF XBIOS(4)=2 PRINT CHR$(27);"q"; ELSE PRINT CHR$(27);"q" ENDIF RETURN ---------- DISPLAYING AN ASCII TEXT FILE ON THE SCREEN ---------- In the special toolkit version of the "Atari ST Virus Killer" that I usually drag around myself, I also implemented a routine that displays an ASCII text file on screen. The skeleton of this routine stems from Stefan - who really is much smarter than me. PROCEDURE text_on_screen CLS LOCAL lo$,a% PAUSE 10 !See note #1 FILESELECT DIR$(0)+"\*.*","",lo$ IF lo$<>"" AND RIGHT$(lo$)<>"\" OPEN "I",#1,lo$ WHILE NOT EOF(#1) LINE INPUT #1,a$ PRINT a$ IF INP?(2) a%=INP(2) IF a%=32 @waitkey !Use the above routine ENDIF IF a%=27 EXIT IF TRUE ENDIF ENDIF WEND IF a%<>27 @waitkey !Use the above routine ENDIF ENDIF CLOSE #1 RETURN Note #1: When using alert boxes or item selectors in a program, it is very likely that the user still keeps the fire button of the mouse pressed when they occur. If the user would have to select to 'load a file' with the mouse and the item selector would appear instantly, the chances are big that a file will be selected in that item selector that the user didn't want. Hence a small pause to make sure that the mouse fire button is released. --------------------------- A SIGNAL ---------------------------- Sometimes, it can be really useful to give the user a signal of some kind. For optimal effect, this needs to be audio-visual, i.e. a bleep and a bit of screen flashing. To most of you, this will seem very simple to do. The screen flashing is a bit more difficult than you may think, though - if you want to do it extremely legally, that is. PROCEDURE scr LOCAL buf% buf%=XBIOS(7,0,-1) !Get value of color #0 buf%=(buf% AND &HFFFF) !Isolate proper word a%=0 !Initiate counter WHILE a%<6 !Not yet six times? IF XBIOS(4)=2 !High res SETCOLOR 0,&H101 !Invert PAUSE 2 !Wait a bit SETCOLOR 0,&H100 !Normal again ELSE !Low res SETCOLOR 0,&H777 !White PAUSE 2 !Wait a bit SETCOLOR 0,0 !Black ENDIF INC a% !Next time PAUSE 2 !Wait a bit PRINT CHR$(7); !Bell sound!! WEND SETCOLOR 0,buf% !Old color #0 back RETURN These were the tips and tricks for this issue. Bye for now! . ON%..  ON AUTOZESTPRG @&DEMO ZST K`kENTRY LST M` README DOC O`D`j A:BtAON5NN N?<NNTA4N <r4<A4Ng$E}pN*/0N < ~A Np"< ~A\Np"< ~AbN < ~A8N < ~A,N < ~A2N < ~ANp"< ~AN?<NATrAЁNp:N/pNB"_NzCN BBBNvpNpNpNp NNpN(pNpNpN6<0<trN:A퀠NtAx *<|~NA (<z |~NAx *<|~NA(<z |~NA x *<|~NA&(<z |~NN+mB+mF -`~A퀠Np+@ -N`l -^HH/ -nB -^HHgF[rSN&(-"mNDp+@ N&*- (-"mNXR p lSSR -o]B`8A퀠Np+@ -N`" -o[rN&(-"mNDSR -o]B`A퀠Np+@ -N`l -^HH/ -nB -^HHgF[rSp+@ N&*- (-"mNXR p lSSSSSSR -o]B`0vg~vgvgvgvgvg<` BA퀠N+m:+m>+mB+mFpWHH/pWHHgppWHH/ -^HHgSN&(-"mNDp+@ N&*- (-"mNXR p l -oS -oS[r`lpfL[r -oS -oS -oS -oS -oS -oS -oS`[rN&(-"mNDSpbfpNpNpN6<p trN:v 0<trN:6<p t r Nv 0<t r Np +@p+@J -Jd -v$-rN` -v$-rNZRJpNJlp +@p+@J -Jd&-pt"-N`&-pt"-NZRJp~JlpN pNpNpNpNN <r4<Ntr N <r4<NtrSN <r4<Nt2<N <r4<Nt2<N <r4<Nt2<%N <r4<Nt2<kN <r4<Nt2<N <r4<Nt2<N <r4<Nt2<=N <r4<NtrN <r4<NtMrN <r4<N4<rN <r4<N4<rN <r4<N4<rN <r4<N4<=rN <r4<N4<yrNpNpNpNp NNpN ANt`P -fAtrNAtrN`0A CN A&C N A trNA&trNNuNN/ AN`Dvgvgvg,vg@vgTvghvg|vgv gpN p ѭRp lj`p(+@+|+|vp+@Hx/-HxvpЭ/N}pNpNpNp NNpN -` E~,pN*tԭ2<N`0E~2pN*tԭ2<N`E~8pN*tԭ2<N`E~@pN*tԭ2<N`E~HpN*tԭ2<N`E~PpN*tԭ2<N`E~UpN*tԭ2<N`|E~[pN*tԭ2<N``E~cpN*tԭ2<N`Dvgvgvgvg4vgJvg`vgvvgv gpN p ѭRp lXN쩲A퀦Ntp(+@p+@Hx/-HxpЭ/N}pNpNpNp NNpN -`HE~ip N*tԭ2<N`E~vpN*tԭ2<N`bE~pN*tԭ2<N`DE~pN*tԭ2<N`&E~pN*tԭ2<N`E~pN*tԭ2<N`E~pN*tԭ2<N`E~pN*tԭ2<N`E~pN*tԭ2<N`E pN*tԭ2<N`rE p N*tԭ2<N`Vvgvgvgvgvg vg"vg8vgNv gdv gzv gpN p ѭRp lpN\B2N`JfN`Uf$HxHxhHxHxN~.A퀦Np+@2N`SfN<`NN`HxHx(HxHxFN~.A퀦NNp+@2`HxHxHHxHxfN~. -oNpA퀦Np+@2`dHxHxhHxHxN~. -oNA퀦Np+@2`0HxHxHxHxN~.NA퀦Np+@2`HxHxHxHxN~.NJp+@2`HxHxHxHxN~.A퀦NNp+@2`HxHxHxHxN~. -roA퀦NN6p+@2`zHxHxHxHx&N~.Np+@2`THxHx(HxHxFN~. -ro Np+@2`(HxHxHHxHxfN~.NA퀦Np+@2`HxHxhHxHxN~.A퀦Np+@2`v(mvFovHmvfo vhm oD m of m o m o m o m &o (m Fo Hm fo hm o` m o6p2fpN\N`JfNuNA NANANANA퀦N$m $m$m"$ml -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^pb]HH/"-fp j]HHgRr(-r mt!]HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HBzBBjBrBnBvR$m/$m/$m/$m /N(-"m,N~$m ($m*$m,$m.N$m T+@j$m $m&<:<N~NjNЭj+@n -ndRn$m T+@r$m U+@v/-j/-r/-n/-vN} -njNNjNTNЭj+@z -njNNjNTN+@/-z/-r/-z/-vN0(-"m2N~xحvzڭn|ܭr.-jN$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H -z(- mb؅!Hz(- mb؅p!HRE,pN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDR N/$m &<:<NN"_NzC6N Ep N*/ -NN"_Nzp+mB+mFp+@` r -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^p b]HH/"-fpj]HHgRr(-r mt!]HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HBzBBjBrBnBvRA퀦N$m/$m/$m/$m /N(-"m,N~$m ($m*$m,$m.N$m T+@r$m T+@j$m $m&<:<N~NjNЭr+@v -vdRv$m U+@n/-j/-r/-n/-vN} -vrNNjNTNЭr+@z -vrNNjNTN+@/-j/-z/-n/-zN(-"m2N~xحvzڭn|ܭr.-jN$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H -z(- mb؅!Hz(- mb؅p!HRE,pN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDR N/$m &<:<NN"_NzC6N Ebp N*/ -NN"_Nzp+mB+mFp+@A퀦NtN쩲NA NANANANA퀦N -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^p b]HH/"-fp j]HHg6Rr(-r mt![HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NREpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@p+@`* -f$N`+m:+m>+mB+mFp+@A퀦NtN쩲NA NANANANA퀦N -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^p b]HH/"-fp j]HHg6Rr(-r mt!ZHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NRE,pN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@p+@`* -f$N`+m:+m>+mB+mFp+@A퀦NtN쩲NA NANANANA퀦N -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^p b]HH/"-fp j]HHg6Rr(-r mt!YHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NREpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@p+@`* -f$N`+m:+m>+mB+mFp+@A퀦NtN쩲NA NANANANA퀦N -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^p b]HH/"-fp j]HHg6Rr(-r mt!^HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /N}REHpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@p+@`* -f$N`+m:+m>+mB+mFp+@A퀦NtN쩲NA NANANANA퀦N -Zf&p+@Z m+P^ m+Pb m +Pf m+Pj"-^p b]HH/"-fp j]HHg"Rr(-r mt!XHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /N}R$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!HRREHpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDEvpN*/$m NN"_NzE}p N,/$m NN"_NzEp N,/$m NN"_NzEp N,/$m NN"_NzEpN,z(-"mNXEpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)Nz(-"mNXEp5N*/ -NN"_Nzz(-"mNXEpN*z(-"mNXp+@p+@p+@`* -f$N`+m:+m>+mB+mFp+@A퀦NtN쩲NA$NA NANAN -`$m/$m/$m /$m$/a`$m/$m/$m /$m$/a`$m/$m/$m /$m$/a`$m/$m/$m /$m$/a`f$m/$m/$m /$m$/af`H$m/$m/$m /$m$/aV`*vg@vgXvgpvgvgvgN쩲NA(NA퀠C퀦N m(+P+m:+m>+mB+mF m+P m+P m+P m +P -f A -rҭ6Ё+@:pЭ6/$m//-:$m /a -rҭ:Ё+@BpЭ:/$m//-B$m /a -rҭBЁ+@p f.pЭB/$m//-$m /a m m+P`pЭB/$m/$m/$m /ap+@`$m $m&<:<N&<:<NNjN+@$m $m&<:<N/?? -&<:<N 8:&NNTNjN+@ - -$mВ+@J$m/$m//-J$m /a -rҭJЁ+@NpЭJ/$m//-N$m /a -rҭNЁ+@RpЭN/$m//-R$m /at -rҭRЁ+@VpЭR/$m//-V$m /aH -rҭVЁ+@ZpЭV/$m//-Z$m /a -rҭZЁ+@^pЭZ/$m//-^$m /a -rҭ^Ё+@fpЭ^/$m//-f$m /a -rҭfЁ+@npЭf/$m//-n$m /a -rҭnЁ+@p f.pЭn/$m//-$m /ad m m+P`pЭn/$m/$m/$m /a4p +@` ` n2g n2g o3g o3g j4g j4g k5g k5g l6g| l6gr g7g2 g7g( h8g h8g i9g i9g` ` A -rҭVЁ+@Z$m/pЭV/$m//-Za -rҭZЁ+@^$m/pЭZ/$m//-^a -rҭ^Ё+@f$m/pЭ^/$m//-fa -rҭfЁ+@n$m/pЭf/$m//-na -rҭnЁ+@p f.$m/pЭn/$m//-aZ m m +P`$m/pЭn/$m/$m /a*p +@`` n2g n2g o3g o3g j4g j4g k5g k5g l6g| l6gr g7g2 g7g( h8g h8g i9g i9g`N쩲NA NANANANpN\BBZBBBmBN`JfN/ AlN 4-rgdpNpNpNp NN4-BfHA(<r*<J,<N.< N$m $m$m"$mlp+@`BAlC<""AHx"HxPHxHHxpN -fp+@`B -fp2NpN4<f2<.N`p2NpN4<f2<.N`~Hx"HxPHxHHxpN -fp+@`B -fp3NpN4<f2<.N`p3NpN4<f2<.N`Hx"HxPHxHHxpN -fp+@`B -fp4NpN4<f2<.N`p4NpN4<f2<.N`Hx"HxPHxHHxpN -fp+@`B -fp5NpN4<f2<.N`p5NpN4<f2<.N`RHx"HxPHxHHxpN -fp+@`B -fp6NpN4<f2<.N`p6NpN4<f2<.N`Hx"HxPHxHHxpN -fp+@`B -fp7NpN4<f2<.N`p7NpN4<f2<.N`Hx"HxPHxHHxpN -fp+@`B -fp8NpN4<f2<.N`p8NpN4<f2<.N`&Hx"HxPHxHHxpN -fp+@`B -fp9NpN4<f2<.N`p9NpN4<f2<.N`A$<N"< NBmB` n2g n2g o3g o3g j4g\ j4gR k5g k5g l6g l6g g7gL g7gB h8g h8g i9g i9g`BN`Sf&~?-?< NMX+@pfB `p+@ N<`&DNN`%/-Hx(/-HxFN~.$m"p2$m]HH/$m "p2$m]HHgA퀦N$m/$m/$m/$m /NRr(-r mt!WHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRRR$m Zz(- m\؅!H$m Xz(- m\؅!H$m rЁz(- m\؅!H$m rЁz(- m\؅!HEpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDEvpN*/$m &<:<NN"_NzE}p N,/$m &<:<NN"_NzEp N,/$m &<:<NN"_NzEp N,/$m &<:<NN"_NzEpN,z(-"mNXEpN*/$m &<:<NN"_Nzp,N/$m &<:<NN"_Nzp,N/$m &<:<NN"_Nzp,N/$m &<:<NN"_Nzp)Nz(-"mNXEpN*z(-"mNXEpN*z(-"mNXp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`N``"N/-HxH/-HxfN~.4-Bg Hxah`"&$m"p $m]HH/$m "p $m]HHgbA퀦NRr(-r mt!XHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /N}R$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!HRREHpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDEvpN*/$m NN"_NzE}p N,/$m NN"_NzEp N,/$m NN"_NzEp N,/$m NN"_NzEpN,z(-"mNXEpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)Nz(-"mNXEp5N*/ -NN"_Nzz(-"mNXEpN*z(-"mNXp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`N``/-Hxh/-HxN~.4-Bg Hxaآ``$m"p $m]HH/$m "p $m]HHgvA퀦NRr(-r mt!YHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NREpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`N``/-Hx/-HxN~.4-Bg Hxa`$m"p $m]HH/$m "p $m]HHgvA퀦NRr(-r mt!ZHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NRE,pN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`N``/-Hx/-HxN~.4-Bg Hxa`$m"p $m]HH/$m "p $m]HHgvA퀦NRr(-r mt![HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NREpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`N``/-Hx/-HxN~.$m $mfxA퀦NRr(-r mt!\HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /N0REZpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`^$m $m fvA퀦NRr(-r mt!\HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /NREpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`NR`/-Hx/-HxN~.4-Bg Hxa`$m $m$m"$ml x$m"p$m]HH/$m "p $m]HHg :Rr(-r mt!]HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HBzBBjBrBnBvRA퀦N$m/$m/$m/$m /N(-"m,N~$m ($m*$m,$m.N$m T+@j$m $m&<:<N~NjNЭj+@n -ndRn$m T+@r$m U+@v/-j/-r/-n/-vN} -njNNjNTNЭj+@z -njNNjNTN+@/-z/-r/-z/-vN0(-"m2N~xحvzڭn|ܭr.-jN$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H -z(- mb؅!Hz(- mb؅p!HRE,pN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDR N/$m &<:<NN"_NzC6N Ep N*/ -NN"_Nzp+mB+mF m+P m+P m+P m +Pp+@`N`` $m"p $m]HH/$m "p$m]HHg (Rr(-r mt!]HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HBzBBjBrBnBvRA퀦N$m/$m/$m/$m /N(-"m,N~$m ($m*$m,$m.N$m T+@r$m T+@j$m $m&<:<N~NjNЭr+@v -vdRv$m U+@n/-j/-r/-n/-vN} -vrNNjNTNЭr+@z -vrNNjNTN+@/-j/-z/-n/-zN(-"m2N~xحvzڭn|ܭr.-jN$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H -z(- mb؅!Hz(- mb؅p!HRE,pN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDR N/$m &<:<NN"_NzC6N Ebp N*/ -NN"_Nzp+mB+mF m+P m+P m+P m +Pp+@`N``/-Hx /-Hx&N~.4-Bg Hxa`$m"p $m]HH/$m "p $m]HHgvA퀦NRr(-r mt!^HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H$m/$m/$m/$m /N}REHpN*/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp,N/$m NN"_Nzp)N(-"mNDp+@p+@+m:+m>+mB+mF m+P m+P m+P m +Pp+@`N``B/-Hx(/-HxFN~.A퀠Np+@`v(mvFoTvHmvfoBvhm o m o m o m oP m oh  m &ov (m Fo>`moٲN`Uf(B/-Hx(/-HxFN~.A퀠Np+@pfN`Jfpbf ANt`@AC N A C&N Ax *<|~NA (<z |~NpN\N쩲A퀠NtN<+@NN+@N<+@NN+@NNpNZEp NpNZEp*NpNZEp NpNZEp.NpNZEp NpNZE[pNpNZEp=NpNZEp NpNZEp*NpNZEp NpNZE(p.NpNZEp NpNZE[pNpNZEVpHxHx/HxHxCazpNpNpNp NNpN Ep N*t?rTNE~cpN*tir`NpN N`SWHH/NHx/HxHxCalpNpNpNp NNpN Ep N*t?rTNE~cpN*tir`NpN N`SWHH/Np8NpNZEvp7NpNZEpANpNZEpDNpNZE2pANpNZEspBNpNZEpANpNZEpDNpNZE:pMNpNZEpQNpNZEpMNpNZE%pKNpNZEppPNpNZEpRNpNZEpNNpNZE`pRNpNZEpVNpNZEpQNpNZEYpWNpNZEpYNpNZE pVNpNZE_pYNpNZEpUNpNZE pRNpNZE_pSNpNZEpTNpNZEpSNpNZEYpTNpNZEpQNpNZEpRNpNZEPpPNpNZEpPNpNZEpONpNZE?pPNpNZEpNNpNZEpHNpNZE%pFNpNZEkp@NpNZEp@NpNZEp?NpNZE*p=NpNZEgp:NpNZEp8NpNZEp2NpNZE pHNpNZElpNpNZESpNpNZE[pNNupN\A(<*<|~#NHx(HxHxHxaVHx2Hx&HxHxaHxHx/HxHxCapNpNpNp NNpN E[pN*t?r]NEapN*tirMN0Hx/HxHxCadpNpNpNp NNpN Edp N*t?rNNEapN*tirMN0 -N`z(-> m\؅ 0H]HH/z(-> m\؅ 0HnBz(-> m\؅ 0HmBz(-> m\؅ 0HnBN`SWHHg`z(-> m\؅/0Hz(-> m\؅/0Hz(-> m\؅/0Hz(-> m\؅/0HaĞNR> ->o]p+@B -N`z(-B mb؅ 0HSfz(-B mb؅ 0H]HH/z(-B mb؅ 0HnBz(-B mb؅ 0HmBz(-B mb؅ 0HnBN`SgBN]N`UfpN\NuA탂NTE,NfpN\EopN*CNzCN HmN&"HA탂,NA탂N|pNEpNg.:p\NC탂N^+@6pЭ6A탂NCN pN\A탂rapNZAvNAvNTap+@nB Vn^HH/ `nmBpWHHg-p+@N@?-?< NMX+@pfpN\p+@N>`B`*hpNJf*h -n`)A퀠NtpNZAvNAvNTap$m$pNZAvNAvNTao$m$pNZAvNAvNTao$m$pNZAvNAvNTao$m $$m/$m/$m/$m /aBpf^BN`JfN`Sf p+@BN`Uf p+@p+@NpqN/NpQNg p+@Bpf -f:Rr(-r mt!WHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRRR$m Zz(- m\؅!H$m Xz(- m\؅!H$m rЁz(- m\؅!H$m rЁz(- m\؅!HEpN*/$m anN"_Nzp,N/$m anN"_Nzp,N/$m anN"_Nzp,N/$m anN"_Nzp)N(-"mNDEvpN*/$m &<:<alN"_NzE}p N,/$m &<:<akN"_NzEp N,/$m &<:<akN"_NzEp N,/$m &<:<akN"_NzEpN,z(-"mNXEpN*/$m &<:<akJN"_Nzp,N/$m &<:<ak$N"_Nzp,N/$m &<:<ajN"_Nzp,N/$m &<:<ajN"_Nzp)Nz(-"mNXEpN*z(-"mNXEpN*z(-"mNX`A퀠N`%A퀠NtpNZAvNAvNTak$m$pNZAvNAvNTak$m$pNZAvNAvNTakn$m$pNZAvNAvNTakN$m $$m/$m/$m/$m /aLBpf^BN`JfN`Sf p+@BN`Uf p+@p+@NpqN/NpQNg p+@Bpf -fRr(-r mt!XHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HR$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!HRREHpN*/$m ajN"_a~Bp,aV/$m ajjN"_a~&p,a:/$m ajNN"_a~ p,a/$m aj2N"_a}p)a(-"mNDEvpN*/$m aiN"_a}E}p a`/$m aiN"_a}Ep a>/$m aiN"_a}vEp a/$m aiN"_a}TEpa~z(-"mNXEpN*/$m ai\N"_a}p,a~,/$m ai@N"_a|p,a~/$m ai$N"_a|p,a}/$m aiN"_a|p)a}z(-"mNXEp5N*/ -ahN"_a|z(-"mNXEpN*z(-"mNX`A퀠N`!A퀠NtpNZAvNAvNTag$m$pNZAvNAvNTag|$m$pNZAvNAvNTag\$m$pNZAvNAvNTag<$m $$m/$m/$m/$m /a8Bpf^BN`JfN`Sf p+@BN`Uf p+@p+@Npqa|/NpQa|܀g p+@Bpf -fRr(-r mt!YHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HREpN*/$m afN"_azp,a{/$m afN"_azp,a{/$m afN"_azpp,a{/$m afN"_azTp)a{h(-"mND`A퀠N`nA퀠NtpNZAvNAvNTaev$m$pNZAvNAvNTaeV$m$pNZAvNAvNTae6$m$pNZAvNAvNTae$m $$m/$m/$m/$m /aBpf^BN`JfN`Sf p+@BN`Uf p+@p+@Npqaz/NpQazg p+@Bpf -fRr(-r mt!ZHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRE,pN*/$m adN"_axp,ay/$m adN"_axfp,ayz/$m adN"_axJp,ay^/$m adrN"_ax.p)ayB(-"mND`A퀠N`HA퀠NtpNZAvNAvNTacP$m$pNZAvNAvNTac0$m$pNZAvNAvNTac$m$pNZAvNAvNTab$m $$m/$m/$m/$m /a~Bpf^BN`JfN`Sf p+@BN`Uf p+@p+@Npqax/NpQaxg p+@Bpf -fRr(-r mt![HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HREpN*/$m abN"_av\p,awp/$m abN"_av@p,awT/$m abhN"_av$p,aw8/$m abLN"_avp)aw(-"mND`A퀠N`"A퀠NtpNZAvNAvNTaa*$m$pNZAvNAvNTaa $m$pNZAvNAvNTa`$m$pNZAvNAvNTa`$m $$m $mf$m/$m/$m/$m /a`*$m $m f$m/$m/$m/$m /a&Bpf^BN`JfN`Sf p+@BN`Uf p+@p+@Npqav/$m a`RN"_atp)au"(-"mND`$m $m fREpN*/$m a`N"_asp,at/$m a_N"_asp,at/$m a_N"_asp,at/$m a_N"_asnp)at(-"mNDRr(-r mt!\HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H`A퀠a}`A퀠a}pNZAvNAvNTa^$m$pNZAvNAvNTa]$m$pNZAvNAvNTa]$m$pNZAvNAvNTa]$m $$m $m$m"$ml $m"p$m]HH/$m "p $m]HHg8BzBBjBrBnBvR$m/$m/$m/$m /a(-"m,N~$m ($m*$m,$m.ay$m T+@j$m $m&<:<a`|a]da\Эj+@n -ndRn$m T+@r$m U+@v/-j/-r/-n/-va -nja]^a]NTa\|Эj+@z -nja]>a\NTa\\+@/-z/-r/-z/-vax(-"m2N~xحvzڭn|ܭr.-jaxBpf^BN`JfN`Sf p+@BN`Uf p+@p+@Npqaq/NpQaqg p+@Bpf -f$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H -z(- mb؅!Hz(- mb؅p!HRE,pN*/$m a[N"_aop,ap/$m a[N"_aodp,apx/$m a[N"_aoHp,ap\/$m a[pN"_ao,p)ap@(-"mNDR Ep am/$m aX`N"_alEpam/ -aX@N"_akEp am/ -aX N"_akEp am/ -aXN"_akp>al/$m &<:<aUa"_akC6aw Ep a|2/ -aWa"_aknpaT"_ajEp al/ -aWa4"_ajz(-"mNXEpa{p/ -aVa"_aj0<%-am/$m &<:<aTa~"_ajEp+al*/$m $maV/?? -nj&<:<aTV8:&aTa~"_aj6z(-"mNX "_acp)ad(-"mNDR acD/$m &<:<aL avd"_ab C6amEbp ar/ -aN&av<"_aapAvapxaE+@n Vn]HH/ _n^HHf pafFfՐAx *<|~abdA (<z |~abPpbfpa_xpa_pa_6<p tra]v 0<tra]6<p t r a^6v 0<t r a^(p +@p+@J -Jd -v$-ra^` -v$-ra]ZRJpNJlp +@p+@J -Jd&-pt"-a]`&-pt"-a]ZRJp~Jlpa_pa^pa^pa^pa^a^ <r4<amtr adT <r4<amjtrSad< <r4<amRt2<ad" <r4<am8t2<ad <r4<amt2<%ac <r4<amt2<kac <r4<alt2<ac <r4<alt2<ac <r4<alt2<=ac <r4<altracn <r4<altMracV <r4<all4<rac< <r4<alR4<rac" <r4<al84<rac <r4<al4<=rab <r4<al4<yrabpa]pa]pa]p a]a]pa]*Aabv`A퀦ab~paP`A퀦abnpa]>Nupa\pa\pa\pa\6<0<traZAx *<|~a_.A (<z |~a_Ata|A a{Aa{Aa{A\a{A8a{Aba{Aza{A>a{ < ~Azay < ~A>ax < ~A8ax < ~Ataxp"< ~A\axp"< ~Abax < ~A ax < ~Aaxrp"< ~Aax`BBBBBrBBBNuN> -f-A>azAzaz < ~A>ax < ~AzaxAtCz  "002A8C>  "002+mrpaZpaZpaZ6<0<traYaf"_aRJp,aS^/$m a>raf"_aR.p,aSB/$m a>Vafl"_aRp,aS&/$m a>:afP"_aQp)aS (-"mawEvpab/$m &<:<a;af"_aQE}p aS^/$m &<:<a;ae"_aQEp aS2/$m &<:<a;vae"_aQ`Ep aS/$m &<:<a;Jae"_aQ4EpaRz(-"mavEpaa/$m &<:<a;aeH"_aPp,aR/$m &<:<a:ae""_aPp,aQ/$m &<:<a:ad"_aPp,aQ/$m &<:<a:ad"_aP|p)aQz(-"mavFEpaa z(-"mav,Epa`z(-"mav`A퀠a[6`$A퀠a[Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m $$m/$m/$m/$m /a&Bpf^BattJfatlSf p+@BatZUf p+@p+@a_pqaP/a_pQaPȀg p+@Bpf -fRr(-r mt!XHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HR$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!H$m z(- m\؅!HRREHpa^/$m a:`abv"_aNp,aO0/$m a:DabZ"_aNp,aO/$m a:(ab>"_aMp,aN/$m a: ab""_aMp)aN(-"masEvpa^Z/$m a9aa"_aME}p aO:/$m a9aa"_aMrEp aO/$m a9aa"_aMPEp aN/$m a9raa"_aM.EpaNz(-"marEpa]/$m a96aaL"_aLp,aN/$m a9aa0"_aLp,aM/$m a8aa"_aLp,aM/$m a8a`"_aLp)aMz(-"marhEp5a]./ -a8a`"_aLjz(-"mar:Epa]z(-"mar `A퀠aWD` A퀠aW&Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m $$m/$m/$m/$m /a2Bpf^BapJfapzSf p+@BaphUf p+@p+@a[pqaL/a[pQaLրg p+@Bpf -fRr(-r mt!YHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HREpa[h/$m a6a^"_aJp,aK/$m a6a^"_aJp,aK/$m a6a^"_aJjp,aK~/$m a6a^"_aJNp)aKb(-"map`A퀠aU>`A퀠aU Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m $$m/$m/$m/$m /aBpf^Ban|JfantSf p+@BanbUf p+@p+@aYpqaJ/aYpQaJЀg p+@Bpf -fRr(-r mt!ZHRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRE,paYb/$m a4a\"_aHp,aI/$m a4a\"_aHp,aI/$m a4a\"_aHdp,aIx/$m a4a\"_aHHp)aI\(-"man`A퀠aS8`A퀠aSRn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m $$m/$m/$m/$m /aBpf^BalvJfalnSf p+@Bal\Uf p+@p+@aWpqaH/aWpQaHʀg p+@Bpf -fRr(-r mt![HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HREpaW\/$m a2aZ"_aFp,aG/$m a2aZ"_aFzp,aG/$m a2aZ"_aF^p,aGr/$m a2aZ"_aFBp)aGV(-"mak`A퀠aQ2`A퀠aQRn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m $$m $mf$m/$m/$m/$m /a(`*$m $m f$m/$m/$m/$m /aBpf^Baj6Jfaj.Sf p+@BajUf p+@p+@aUVpqaF/aUJpQaFg p+@Bpf -f$m $mfREZpaU/$m a1aY"_aDp,aE/$m a0aX"_aDp,aE/$m a0aX"_aDp,aE/$m a0aX"_aDhp)aE|(-"maj `$m $m fREpaT/$m a0`aXv"_aDp,aE0/$m a0DaXZ"_aDp,aE/$m a0(aX>"_aCp,aD/$m a0 aX""_aCp)aD(-"maiRr(-r mt!\HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!H`A퀠aNB`A퀠aN$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m$Rn(-n mz 0H$m $$m $m$m"$ml $m"p$m]HH/$m "p $m]HHgBzBBjBrBnBvR$m/$m/$m/$m /N(-"m,ah6$m ($m*$m,$m.aJ&$m T+@j$m $m&<:<a0a-a-LЭj+@n -ndRn$m T+@r$m U+@v/-j/-r/-n/-vN} -nja-a-a[la,Эj+@z -nja-a-fa[La,+@/-z/-r/-z/-vN0(-"m2agLxحvzڭn|ܭr.-jaI>Bpf^BafJfaeSf p+@BaeUf p+@p+@aQ pqaB`/aQpQaBTg p+@Bpf -f$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H$m z(- mb؅!H -z(- mb؅!Hz(- mb؅p!HRE,paP/$m a,8aTN"_a?p,aA/$m a,aT2"_a?p,a@/$m a,aT"_a?p,a@/$m a+aS"_a?p)a@(-"maeXR p$a@ (-"madREHpaO/ -ja+aS"_a>p,a?/ -ra*aS"_a>p,a?/ -na*aR"_a>p,a?/ -va*aR"_a>rp)a?(-"mad*REZpaO/ -za*aR"_a>"p,a?6/ -za*LaRb"_a>p,a?/ -va*2aRH"_a=p)a?(-"macR / -r&<:<a'aQ"_a=p,a>/ -n&<:<a'aQ"_a=rp,a>/ -v&<:<a'daQ"_a=NEopa>/ -a)raQ"_a=.p$a>B(-"mabREvpaM/$m a):aQP"_a/$m a)aQ."_az/$m a(aQ "_aX/$m a(aP"_a6/ -a(aP"_a/ -a(aP"_aa=D/$m &<:<a& aPd"_a< C6aGEp aL/ -a(&aP<"_a;p&/$m &<:<a%aOR"_a:Ep+aa3/$m &<:<aaF"_a2xC6a>Ebp aC/ -aaF"_a2PpaF"_a2*Epa3Cpqa02/a>pQa0&g p+@Bpf -fRr(-r mt!^HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HRr$m (-r mt!HREHpa>/$m a6aBL"_a-p,a//$m aaB0"_a-p,a./$m aaB"_a-p,a./$m aaA"_a-p)a.(-"maSV`A퀠a8`A퀠a8pR(-"m>aSjC퀬a8Rn(-n mz 0H+@Rn(-n mz 0H+@pa2pa2pa2p a2a2pa2A퀬$-"-a8.pa2Bpf^BaQJfaQSf p+@BaQUf p+@p+@antr a5@ <r4<a>VtrSa5( <r4<a>>t2<a5 <r4<a>$t2<a4 <r4<a> t2<%a4 <r4<a=t2<ka4 <r4<a=t2<a4 <r4<a=t2<a4 <r4<a=t2<=a4r <r4<a=tra4Z <r4<a=ptMra4B <r4<a=X4<ra4( <r4<a=>4<ra4 <r4<a=$4<ra3 <r4<a= 4<=ra3 <r4<a<4<yra3pa.pa.pa-p a-a.pa.Aa3b`A퀦a3jNuA(<*<|W.<a0PHxHxYHxHxN}HxHxgHxHxNHxHxHx:HxN}Hx0<Yt#r5a&At1rEa)pa(VEp a3T4<t2<a-Epa3<4<trPa-E~cpa3&4<t2<!a-Ep3a3t;2<a-pa'pa'pa'p a'a'ECp!a2tN2<a-Ppa'pa'pa'p a'a'Edp3a2tO2<a-Ep1a2tc2<a-Ep-a2~tv2<a,pa'4pa'2pa'0p a'.a'6Epa2L4<rBa,pa'pa'pa&p a&a'Epa14<7rGa,Ep=a1~4<NrGa+pa&d` pa%pa&pa&6<>0<Yt#r5a$XAt#r6a&pa&,Ep a1*4<t2<a+Epa14<trPa+E~cpa04<t2<!a+nEp+a0t=2<a+Xpa%pa%pa%p a%a%Ep3a0t=2<a+&Ea/4<r?a)Ep>a.4<r?a)ppa#pa#pa#p a#a#EBp+a.4<r>a)>pa#pa#~pa#|p a#za#Emp>a.4<r>a) Ep@a.4<r8a(Ep=a.l4<rFa(E(p?a.V4<r>a(pa# pa# pa#p a#a#Egp&a.$4<r>a(pa"pa"pa"p a"a"Ep;a-4<0rFa(fEp7a-4<Er\a(Ppa"pa"pa"p a"a"pa"`*pa">pa"Hpa"F6<>0<Yt#r5a At1rEa#pa"nEp a-l4<t2<a'Epa-T4<trPa'E~cpa->4<t2<!a'Ep'a-&t82<a'E&p2a-tM2<a'pa!pa!pa!p a!a!EXp.a,t82<a'REpa,tM2<a'4<rHa&pa pa pa p a a E\pa+4<rAa&jEp8a+4<rKa&TEp a+4<r;a&>pa pa ~pa |p a za Ep4a+4<rKa& EKp?a+4<r;a%Ep@a+l4<r:a%Ep=a+V4< rCa%pa pa pa p a a Epa+$4< rCa%Epa+4< r8a%E5p#a*4<5r@a%lpapapap aaEXp@a*4< r8a%:Ep=a*4<5r@a%$pafpadpabp a`ahEpa*~4<Kr7a$pa4pa2pa0p a.a6EpAa*L4<Kr7a$pa2`papapa6<>0<Yt#r5a&At#r6apaE,p,a)t:2<a$lEXp2a)tN2<a$VEp0a)tb2<a$@Ep4a)tw2<a$*palpajpahp afanEpa(4<r>a"Ep1a(j4<r@a"pa papap aa"E p#a(84<-2<a"E/p"a( 4<@2<a"EQpa(4<S2<a"zpapapapaaE}p a'4<S2<a"Fpapapap aapa` vg vg,vgvgN`*a7papa?<NATrAЁa(p:a/pa+j"_aCa"&A퀦a!a8 N Nua 24&8:BfJBg f DfpNuJEgpNu 24&8:BgmpNu<ngfDdpNufAdpNu 24&8:JBgfDf EfpNuJEgpNuDExa*`bDEa"`ZaR11!Nua11!Nu 24&8:DE`6 24&8:DB`&a&8:DE`DEx`a` 24&8:HnghDBHngXDE~<En g6@ABDFGcGcGb8(vHDl`G8BCHC` GHD8HD쬵k&Dуd QRB BbJjDBNu DENupN֓DjdDA@ cAр[SBoJjDBNurptNuH@g0J`Ѐ[rGoJjDBNu0ftNu@[rB oH@JjDBNu $HkBk Bj*DBNupNuDBBkBjDBDNuf gp` 246jDCCe0 C/jC C@j C jr0H@{0>H@Nur{0Nu{0NutNu 246j(:<DCaf AfBfNu`a 00Nur$o, b4< J@k @[H@NuH@RBNu4<Ѐ[NuDg8k2 b4< J@k @[H@DBNuH@RBDBNu4<Ѐ[DBNu4H@Ѓdh`^HCH@:">H@`H2g&HCH@:<HC>H@Ѓd(`HCH@:H@r` gDBgkDE`HDBDEaBDBNugDBa8DBNutNua 11!Nux`xa`a` 24&8:HoHoEBJAgJDfr:g,|HC҅H@:ۆ<HC>H@Ѓd`vHCH@:H@`fgDBgkDE` DBDEaDBNugDBaDBNutNuHoHoEBz:g|HC҅H@:ۆ҄ۆ<HC>H@ЃdHA@B@H@хk HAҁHAрSB BbNuJBj^tNuk(g.JBjDBAр[SBDBjNutNuAр[SBkNuJlNu0gH@rJBkB JkЀ[`DBЀ[`J.;gP:pr4<Nup`6xa2`Ba411!Nux`4 24&8:`& 24&8:`a&8:` &8:@ABJEoHnfNup`tNugDEDBHngDBEBkQ*HEJDg?<>0rHGGdHGGdSWDуdi?<>0rHGGdHGGdSWDуdi2?<>0rHGGdHGGdSWDуd&2 H@kփAр[SBkփejRAd RdQRBJjDBNutNuCEdSW`?<,>CEdGeH@0r`fJCgz?<0rÐdSWЃdi?<0rÐdSWЃdid?<0ÐdSWЃd&2 H@kփAр[SBkփejRAd RdQRBJjDBNutNu?<0riP?0i?`?<`XapE(gP`LJg&B.C`a8aD*9 fap-I,=|p4aHz*9 g ENp9` _a &nO:NM(I-KZ$<Nu[1][Error +111][Return]EX g g>Jf`Ar Hjr-D@Hd0H@H 0H@0CNuAF"H [1][fSEfNu`HQ?< NA\Nu"_KZM(I-O:HQ <-H*,`N,4d d3 d# d# # d# # # # d ALH dAL H LH d AL`H L|0H>L|H>d~# # # # A`@ALH L|H>L|H>L|PH>L| H>L|H>L|H>L|H>L|`H>L|0H>L|H>QL|Nu$H$&"BA -KaXA"f B &nNuH>dd2d"d""d""""d LHC dLHLH C@d LHL|H| L|H|PCd~""""C`:LHL|H| L|H|PL|H|L|H|L|H|L|H|L|H|@L|H|pL|H|L|H|CQL|Nua`Np?a a?<LNA``NuNu`aza`aaaHA-Hhp alpMah=@F?<NNTT@A0r p0Q`pdr ta0.F=@=@ACp,2QAp 2Qa a`\`Xpea>pCR2Ad0A2r22aZ"<;0<NBLNurt=@:=A@=B NuHz(` N;Hz ?<&NN\Nu9gNuWNu|^|  R^,T:&0D4(*<B$,>2::(   F..26"8@"PQ1!P1P!0PP`0  q#aaa a O: n*NNuNuNupc?a0QNurdAd6Ag,B(dB(dH Ao<atoBAp`dNuNu?<OA`d?<IA`Z0<H IafLt Ig Og Ug Ag Rg,afNup`a8p`V0afHRa>Er$Wgr STD:gr COM:g r LPT:f4FA$_0=@Dk"~CA0< BhaB2"pNu$_AF Ge><QBAFpNuafgzp=` aZgzpaTaRFBd&8*L?af<aSF Be BgQRB`RAdR e <rRF&0xaCձfEv+0JFjDFv-Hƌd0BFHF 0HF0ANuprt|`HQ2.d Aeg>r C 5e&!R 0c 9c0`<R"_`VC0 Ef"_Nuaa/ CFr  g 00VJAgB @ nN @mHJ@j0.4DBUBk0QSAg Q.`S@k 0`0BAF "_Nu.WAkQA 0g`prt|P;Q:  g +g -f .g40  b 0e 9b da6`RF` .f 0e 9b daSF` Eg efX +g -f 0e 9oSH`00  b&Hz0  b E Do`ZJjDDDS4<.aXJFkSFk4arQaD`&HaFFaZQ&8*L/a,H܆jDBJ.:gtBn:Nu @$@JfS aZ`QNu$Aa<`QBNuHz ta `Hz jaH `LHPHQ0(ika $I _aIUd4Id4Id$Id `$$$$Q _Jf,aId4Id4Id$Id `$$$$Q @NuSaIdIdId`Q @Nup `/ ab$I> _aXG` VNuag`af`ae `ac` acpNuadpNu/ a$I> _a4Ae4v` VfANuHP0(R@kBa $I _aIUd4Id4Id$Id `$$$$Q @JfNuNup `aSAfNuag`af`ae `ac` acpNuadpNuapSAkfJANuH HPhkJab $I _aJIUd4Id4Id$Id `$$$$Q @JgSL`QNup `,aAf` VNuag`af`ae `ac` acpNuadpNua4@m4v` Vf@Nu/HP0(X@kHa $I _aIUd4Id4Id$Id `$$$$Q @Jf$Nu $Nup `|aTYAfNuag`af`ae `ac` acpNuadpNua SAkEF$p VfWANu?HP0(T@kHa $I _aIUd4Id4Id$Id `$$$$Q @Jf4Nu0XNup `aUAfQNuag`af`ae `ac` acpNuadpNuavSAkXf SAkXfJANuz`z `z8.^n\Dn\@Hp tr=ED`6n\n^n\n^A0000000000prt`n\n^648HH`prt`n\n^n\n^8HH`prt`"_A `4RB`"_A42L\A` L0GF11Q-p`prHQ`rBp'rtad n2rt6(SC0(S@apaB\papava0paRG=GYfx-IC=C=C$tBft=B=B(tFJ=BBBB*Do>Eo:@l6Al2DDk =DVBnDEk =EnBn@cVo Acno,_NuAH`/=@a _a ]Ak024E$ Bb5B5A6CC5CK5C:8AB0000DkxEkt00A<:d>:bSFSGFn\GnXDDk0BhDEk1EBh Fchh Gchh0hb"0hbpmrt-|IH-|IL`Nu-HN??<NNT-@XDbDEbEBb=ET=DV-|PBLBp n20(L=CJ?=B^C=C\=Cj@drAdnED??RGRF=GF=FHtGJ=BltBft=B`=BnGOpЇЇ b na222-IfHVMF,_Nup `TT np`??/ a , > _a 4$FAFp_@[000][vx`* [g" ]g |g QSx` xQSrQ][vx`* [g" ]g |g QSx` xQStQ]BAF0-H,=@p4a62HNu 24DBaDB11!Nu 24DBa DBNu 24x6o<Ce(FC BdЄeNu B/dHDDdRdQRBNu&<:<`bg BbUC BcjNu BcHDDdSkg RBAрjNuNu0ftNuB H@"jNuE"ea"ep`&6NuE "e a"d&&6NuE"e aµ"d66NuE"e a"d666NuE"e a"d6Nu <}a$Ia `$XaH`aHR?<NNT @"_ <}Nuvn\n^~Ha0 @xepw2AtE4*jDjHB t`0QTAtp =| D`aV`QNuHg"cc/ 0)a4 _$PS@kH2QNu2(g$PRAA4DBH%$Y2Pg 1AHRAA%NuBhNuao aШNupNuaJFoHPJhja?<?B?<BNAO _*kBg?/(?<BNAO Jk NuNafoazJBkAf`a|??/?<BNA.k \Hx?<BNAO [HHNux`x*0ao< 2fJjr`Nu~dGdEH<Nup`f0@F@AJhg PLNu`FLJg(HPBHh/??<@NAXLf ѨLNuJkp%` aJBja!| ??<>NAXOJkpNu0< aH`0< CF2p`p a2`p CFp`a CF"p`Hza`HyP"J`B.@=|DNua.@FpAR@C` B.@=|DNuB.@a=GDgNup`Da`aCF"E p`.D<jRGg>VGg:TGjp`HPa0CF$IpR@  f _aHd2Hd2`"QNu`<.DHSGFaAEg f< &_Nua`Nu.dfaBZ=n`r>.D<jRGg.D<jRGg*VGgTGjp`<.Da*`" yZ faa$` yZ f aa AF "g pR@0 ,g  g  fHp`:pR@0  g  g "fR@0 ,g  g  fHpRU@"_  f#Z$H _a`QNupR@0 ,g"  g  fa~ (fR~Nua ~ `a~NuaJkHQ ! gRf _NuXX~Nu0j\@??<NMXJk .dgp Nu`<.DHSGFa ,g gAEf< &_Nu ."Ff +"g ,g` 24JBkCkNuCktNu 24JBoSBNugRBNu2(gbc  P"H`Nu/0Ha2  _ PSAvjx E(Wf* ae zb Q @Nupagp?<?NMX"NuBnp`pBnp`p=| p|=Fn@=@b=n`raHj=Ah~`:a JfBH@ RfF.f Kg" Mg sg tg Pg Hf~`xSGjtRGFcn>`jAF gp gj g grffnnpenbfJ.fj6pRGFc$SG` J.fjpRGFcRF` Ff`> `?~ap a0p a*0Nu|``CpE`bf`FgRGJGgSGSFFgCpE`Yf`Nua@Jf gH@ fa(@ fza0 b @ Ee0Nua2gNu4.rf?HyaNM\Nu=|D`LjazEfpadppa`AFEg0PaEfaFRE`ܾEfp a@a8?nnnp a2RF`<annoS@f nhfSnl=Ah=FnNup` papq4.rf?HyajNM\Nu=|DHaLNu|A0"P2(@e2<EF`QHP=|DJ@g$abAF$HpR@ 0 f _a`QNuHPp?ap a _2<|0`C&pHQ/Hy@NA NuC pa:NuHQ/Hy?NA Nu&g4 Fga<gJAga2< R@AdSf0Nu0a*p Ce`&g4 FgaJBjagPAe CbRa R@Sf0Nu FgRag JBjaʰAeaJAg RP0 pNu` Fg6agJAga @eaRP Nup NHѨB?<?/?<BNAO JkLLNu&8a"JBja:JAg Df*ڃkd0Nu DfրBH??/?<BNAO LJk!@NuHBHh Hx??<?NAO LJo ѨLNuk:fp`^k: g ѨNuBHPHQ/??<?NAO _JoѨfNuBHPHQS/??<@NAXLfѨNuJkp%`њB9`$H EaTA AerQBL@͉H Ia"H _/ aa _/ ?aAF-H AerQB2"_A&-H A e ` \gQBa9gaZe -|p[`pZaajAF"H0.g "Hg \f`A&fS !.gR EF _aV`QNuHz?<&NN\ @Nu x NuA@Bh`DA@aN n@!|}Nup#$fpNup`p`# Nu(aھ؀.dfaڰjNu?a0` ?a2@@a~` a Nu4.`Af n2LR@RANu4.`g S@SAHNutbpbr??paLpYaF0a@0`:aNf"_O:N"_O:HQ`6 94g"94gJ9fga"AO:Np\B `fG06#f&#-KNuk"c" C gT6f`Pv6"cgRCC(D#8`aJANuag `af`apNuapNuC`C``C` C`C-KJhfJfRRRRRRRHP? @CFH~8:E#P&<2 `b$bYEf`"RAf rЁЀ`&Ѐe "ЀeЁdp`jJAkfgRer?DDЁaAaо8$HX :CFE` YEjT"_$P"2trDDd0d d d` QjNu`aDa DNu na^ K"ng42 $`gk2&Hg Af deђ$`ebѐXf&nNu AgebѐA``-Kx$ n&$n""Hg8" &Ak cѐ S`g"" k#&Acё2+SAI3 Q&f-I"&nNu-Kx$&ր n&$n""HgR" k&Ac b S` S`g4" k#&AcbrkX`ޑ2+SAI3 Q&f-I"&nNuaT n2L6(n\n^HHHNua4 n20(n\HNua" n20(n^HNua n20(HNu`aZNu"H YJQfNu YH瀀aRLP|HPGj2C&֛֛֛֛֛(HDDCBg6Cv6C[RCF8[[[aL6C[RCF8:Gj2FWfTL L-KA `φ$I\bfBjQNu$YbfBjQNu؄*؄؅CH`嶘؅X`$_  IaYHR"H @`ʘ؄*؄؅AHNu؅X`$_ IaYHR"H` n}d$HJf-HS Nup"`HPa _ax`QNua JH aL0Nua` 09209201000000000000000000000000000000016000000000001200000000000125200000000007252000000000063254000000000025525500000000032552550000000001519212712800000000600151920000000124803224000000072242551932240000000311932552402400000000127199255240120000000325513525519225200000015255143254325400000063633124815254000000252633122412722300000722463311292553112800003112863287255311280000126063163125531192000124812630127254312240007224601271312552543124000063192252127135255252632400002551952521271952552486324800325520725212722425524012718800125525524812724063192254600002552552481272480324030002255255248255254071921270061272552482552551926312551280763255248255255255248152551920719125524825525525522463255192072232552482552552551286325522407207255248255159254063255240072312552402541524830312552400724725524124815224127152552480152432552412243122525572552520152492552411281272472551352552540152522552401255255255195255254015254255240719525525522525525501525512724030025525524025525512815255632401200255255240255255128152551592412401201272552481272551923125522324722525225525525263255224312552072552272552552552526325512831255231255199255255255254312540312552432551992552552552551524819231255251255199255312552551432311283125524925519924032552551913112863255252255199128125525525212712863255254255224012552552412550632552551272243240255255207255031255255632486324825525463254015255255159255255248255248255254072552552232552552482552272552540725525523925525524825514325525203255255231255255241254632552520125525524325522319324125525524801255255251255142319925525524800255255249255015312552552480012725525225512860127255255240006325525412722422725525525524000632552551272551432552552552240031255255632546325525525522400152552551592482552552552551920072552552231992552552552551920072552552396325525525525519200325525522825525525525525512800125525524125525525525525200002552552432552552552552400000255255247255255255255192000012725523125525525525500000632552312552552552520000063255239255255255240000003125520725525525512800000152552072552552540000007255223255255248000000725515925525522400000032551592552550000000125519125525200000001255632552400000000025563255192000000001271272550000000006212724800000000062127224000000000302551280000000001225400000000004248000000000051920000000000100000000000000000000000000000000-105806001000000000000000000001200128000001201319200000120312240000025063224006200255127224006201255125240006201254253240002550572482482400025506124824824000255316024024824001255301242402492400125515812424024924003239190124240241240032391901242402512400323919012024025522403239190120240255224072391901202401271920725519012024012712807255254120240620072552542522400311283125525425224802551286324725525224072551286319925525233125503113522318831223248015135223128127223248015135192025520724803113519212551932480311351923247193248031128032391292400310072391240007128719212400063128719212400125519271923240072551927224324007255131247248324007255135243252324007159143251254322400313124825532240063302486332240062622483113122400126602401513122400124125240311312240025212722431322400252127198633224012481271432541192012481201525200032401242552480007240127255240000722412723119200015227191192000015207223128000031255196000003125512800000312550000003124800000015192000000700000000000000000000000-1| Monochrome only! GFA INTERFACE CREATION UTILITY VERSION 1.1 COPYRIGHT 1991, DAVID BECKER COMPUSERVE MAIL 73030,3562 GENIE MAIL TO D.BECKER8WindowButtonText BoxInfo BoxLine Box LineSliderPlatformCancel Add textSave with ZeST codeSave procedure only Save the ZeST logoToggle ruler on/offCreate a new screenTest this interface Load an interfaceScan this interfaceQuit to the desktop CancelGOSUB zest_info_box(,coverupGOSUB zest_button(GOSUB zest_vert_line(,sliderIF mx%> AND mx% AND my%< AND MOUSEK=1 AND pos_x%<>MOUSEX- AND MOUSEX- AND MOUSEX+ THEN%=MOUSEX-' (pos_x) reflects this sliders position from 0 to PUT pos_xENDIFGOSUB zest_horiz_line( AND MOUSEK=1 AND pos_y%<>MOUSEY- AND MOUSEY- AND MOUSEY+%=MOUSEY-' (pos_y,pos_y%,sliderGOSUB zest_line_box(GOSUB zest_text_box( AND my%> AND MOUSEK=1 THENGOSUB zest_button_press(' Here is where your own code goes for button number GOSUB zest_window(PROCEDURE draw_screen' Create any ZeST box, button or window by passing the' upper_x%, upper_y%, lower_x% and lower_y% coordinates' to the correct procedure.' -------------------------------------------------------------->' Place text throughout the interface...DEFTEXT 1,0,0,13GRAPHMODE 2GRAPHMODE 0RETURNPROCEDURE monitor_mouse SHOWMmx%=MOUSEXmy%=MOUSEY' This button press exits the window and ends the program.\*.LSTZSTzstzest_screenzest_logo' ZeST Alternative Interface' Copyright 1991, David Becker' Compuserve 73030,3562 / GEnie mail to D.Becker8GOSUB initGOSUB draw_screenGOSUB monitor_mousePROCEDURE init ' check screen resolution rez=XBIOS(4) IF rez<>2 THEN ALERT 3,,1, ENDIF ' fill entire screen with desktop pattern CLS DEFTEXT 1,0,0,13 DEFMOUSE 0 BOUNDARY 0 DEFFILL 1,2,4 PBOX 0,0,639,399PROCEDURE zest_button(upper_x%,upper_y%,lower_x%,lower_y%) DEFLINE 1,1 DEFFILL 0,2,8 PBOX upper_x%,upper_y%,lower_x%,lower_y% PBOX upper_x%+1,upper_y%+1,lower_x%,lower_y% LINE upper_x%+1,lower_y%,lower_x%,lower_y% LINE upper_x%,lower_y%+1,lower_x%,lower_y%+1 LINE lower_x%,upper_y%+1,lower_x%,lower_y% LINE lower_x%+1,upper_y%,lower_x%+1,lower_y%+1PROCEDURE zest_button_press(upper_x%,upper_y%,lower_x%,lower_y%) GET upper_x%-1,upper_y%-1,lower_x%+1,lower_y%+1,button$ GET upper_x%+1,upper_y%+1,lower_x%-2,lower_y%-2,shift_button$ PUT upper_x%+2,upper_y%+2,shift_button$ LINE upper_x%,upper_y%,lower_x%,upper_y% LINE upper_x%,upper_y%,upper_x%,lower_y% COLOR 0 COLOR 1 SHOWM LOOP UNTIL MOUSEK=0 PAUSE 3 PUT upper_x%-1,upper_y%-1,button$PROCEDURE zest_info_box(upper_x%,upper_y%,lower_x%,lower_y%) LINE upper_x%,upper_y%+1,lower_x%,upper_y%+1 LINE upper_x%+1,upper_y%,upper_x%+1,lower_y%PROCEDURE zest_text_box(upper_x%,upper_y%,lower_x%,lower_y%) PBOX upper_x%+2,upper_y%+2,lower_x%-2,lower_y%-2PROCEDURE zest_horiz_line(upper_x%,upper_y%,lower_x%,lower_y%) LINE upper_x%,upper_y%,lower_x%,lower_y% LINE upper_x%,upper_y%+1,lower_x%,lower_y%+1PROCEDURE zest_vert_line(upper_x%,upper_y%,lower_x%,lower_y%) LINE upper_x%+1,upper_y%,lower_x%+1,lower_y%PROCEDURE zest_line_box(upper_x%,upper_y%,lower_x%,lower_y%) BOX upper_x%,upper_y%,lower_x%,lower_y% LINE upper_x%-1,upper_y%,upper_x%-1,lower_y% LINE upper_x%+2,lower_y%-1,lower_x%-2,lower_y%-1 LINE lower_x%-1,upper_y%+2,lower_x%-1,lower_y%-2 LINE upper_x%-1,upper_y%-1,lower_x%,upper_y%-1PROCEDURE zest_window(upper_x%,upper_y%,lower_x%,lower_y%) ' title bar GOSUB zest_button(upper_x%,upper_y%,lower_x%,upper_y%+20) ' window area GOSUB zest_button(upper_x%,upper_y%+22,lower_x%,lower_y%) ' close button GOSUB zest_button(upper_x%+5,upper_y%+4,upper_x%+18,upper_y%+16) Too thick!Too small!' This saves the previous screen image in a string variableSGET putback$' This dummy command forces an exit of the loop and the procedure...EXIT IF 1=1' Display the previous screen image before returning to the main programSPUT putback$' To include the ZeST logo in your program simply call this' procedure ONCE at the beginning of your program and then' PUT x_pos%,y_pos%,zest_logo$' anytime you wish to place the logo on a white background.'----------------------------------------------------------- zest_logo$=RESTORE zest_dataREAD dtaEXIT IF dta=-99zest_logo$=zest_logo$+CHR$(dta)zest_data:DATA 0,92,0,92,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0DATA 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,16,0,0,0,0,0,0DATA 0,0,0,0,0,120,0,0,0,0,0,0,0,0,0,0,1,252,0,0,0,0DATA 0,0,0,0,0,0,7,252,0,0,0,0,0,0,0,0,0,0,63,254,0,0DATA 0,0,0,0,0,0,0,0,255,255,0,0,0,0,0,0,0,0,0,3,255,255DATA 0,0,0,0,0,0,0,0,0,15,192,127,128,0,0,0,0,0,0,0,0,60DATA 0,15,192,0,0,0,0,0,0,0,1,248,0,3,224,0,0,0,0,0,0,0DATA 7,224,255,193,224,0,0,0,0,0,0,0,31,193,255,240,240,0,0,0,0,0DATA 0,0,127,199,255,240,120,0,0,0,0,0,0,3,255,135,255,192,252,0,0,0DATA 0,0,0,15,255,143,254,3,254,0,0,0,0,0,0,63,63,31,248,15,254,0DATA 0,0,0,0,0,252,63,31,224,127,223,0,0,0,0,0,7,224,63,31,129,255DATA 31,128,0,0,0,0,31,128,63,28,7,255,31,128,0,0,0,0,126,0,63,16DATA 31,255,31,192,0,0,0,1,248,12,63,0,127,254,31,224,0,0,0,7,224,60DATA 127,131,255,254,31,240,0,0,0,63,192,252,127,135,255,252,63,240,0,0,0,255DATA 195,252,127,195,255,248,63,248,0,0,3,255,207,252,127,224,255,240,127,188,0,0DATA 1,255,255,248,127,240,63,192,254,60,0,0,0,255,255,248,127,248,0,3,240,30DATA 0,0,2,255,255,248,255,254,0,7,192,127,0,0,6,127,255,248,255,255,192,63DATA 1,255,128,0,7,63,255,248,255,255,255,248,15,255,192,0,7,191,255,248,255,255DATA 255,224,63,255,192,0,7,223,255,248,255,255,255,128,63,255,224,0,7,207,255,248DATA 255,159,254,0,63,255,240,0,7,231,255,240,254,15,248,30,31,255,240,0,7,247DATA 255,241,248,15,224,127,15,255,248,0,15,243,255,241,224,31,225,255,7,255,252,0DATA 15,249,255,241,128,127,247,255,135,255,254,0,15,252,255,240,1,255,255,255,195,255DATA 254,0,15,254,255,240,7,195,255,255,225,255,255,0,15,255,127,240,30,0,255,255DATA 240,255,255,128,15,255,63,240,120,0,255,255,240,255,255,128,15,255,159,241,240,120DATA 127,255,248,127,255,192,31,255,223,247,225,252,255,255,252,63,255,224,31,255,207,255DATA 227,255,255,255,252,63,255,128,31,255,231,255,199,255,255,255,254,31,254,0,31,255DATA 243,255,199,255,255,255,255,15,248,192,31,255,251,255,199,255,31,255,255,143,231,128DATA 31,255,249,255,199,240,3,255,255,191,31,128,63,255,252,255,199,128,1,255,255,252DATA 127,128,63,255,254,255,224,0,1,255,255,241,255,0,63,255,255,127,224,3,240,255DATA 255,207,255,0,31,255,255,63,248,63,248,255,254,63,254,0,15,255,255,159,255,255DATA 248,255,248,255,254,0,7,255,255,223,255,255,248,255,227,255,254,0,7,255,255,239DATA 255,255,248,255,143,255,252,0,3,255,255,231,255,255,241,254,63,255,252,0,1,255DATA 255,243,255,223,193,241,255,255,248,0,1,255,255,251,255,142,3,199,255,255,248,0DATA 0,255,255,249,255,0,15,31,255,255,248,0,0,127,255,252,255,128,60,127,255,255DATA 240,0,0,63,255,254,127,224,227,255,255,255,240,0,0,63,255,255,127,255,143,255DATA 255,255,224,0,0,31,255,255,63,254,63,255,255,255,224,0,0,15,255,255,159,248DATA 255,255,255,255,192,0,0,7,255,255,223,199,255,255,255,255,192,0,0,7,255,255DATA 239,63,255,255,255,255,192,0,0,3,255,255,228,255,255,255,255,255,128,0,0,1DATA 255,255,241,255,255,255,255,252,0,0,0,0,255,255,243,255,255,255,255,240,0,0DATA 0,0,255,255,247,255,255,255,255,192,0,0,0,0,127,255,231,255,255,255,255,0DATA 0,0,0,0,63,255,231,255,255,255,252,0,0,0,0,0,63,255,239,255,255,255DATA 240,0,0,0,0,0,31,255,207,255,255,255,128,0,0,0,0,0,15,255,207,255DATA 255,254,0,0,0,0,0,0,7,255,223,255,255,248,0,0,0,0,0,0,7,255DATA 159,255,255,224,0,0,0,0,0,0,3,255,159,255,255,0,0,0,0,0,0,0DATA 1,255,191,255,252,0,0,0,0,0,0,0,1,255,63,255,240,0,0,0,0,0DATA 0,0,0,255,63,255,192,0,0,0,0,0,0,0,0,127,127,255,0,0,0,0DATA 0,0,0,0,0,62,127,248,0,0,0,0,0,0,0,0,0,62,127,224,0,0DATA 0,0,0,0,0,0,0,30,255,128,0,0,0,0,0,0,0,0,0,12,254,0DATA 0,0,0,0,0,0,0,0,0,4,248,0,0,0,0,0,0,0,0,0,0,5DATA 192,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0DATA -99 Exit?YesNew screen?\*.ZSTUse the left mouse buttonto confirm elements as theyappear or the right buttonto delete elements. Hit 'Q'to keep everything else.Next ScreenPrevious ScreenAuto ZeST completely automates the creation of ZeSTfront end graphic user interfaces for use with GFA.Auto ZeST saves authentic GFA source code to diskwhich can then be merged into the GFA editor.What makes up a ZeST interface?ZeST Windows ... not unlike GEM windows with a title bar anda close button. ZeST windows are static.ZeST Buttons ... 3D push buttons that activate your own code.ZeST Text Box ... carved inset box for alphanumeric output.ZeST Info Box ... carved box with a desktop background.ZeST Line Box ... carved line box for highlighting areas.ZeST Sliders ... moveable sliding buttons inside carved slots.ZeST Platforms ...raised platforms that contain buttons, etc.To create any ZeST element simply define an outline by dragging the mouse with the left buttondepressed and then choose the type you want when choice buttonsthe appear. If you want to createmultiple copies numeric keypad simply type the number on the .The desired number and direction of copies will appear for every arrow keyspress of the keypad. You can also use the to copy aprevious outline box in the desired direction. A safety buffer UNDOholds the last creation and if you hit you can cancel andremove your last created element. If you want to draw a verticalor horizontal line simply make sure the sides of your outlinebox are touching and then select from the choice buttons. linesPlease don't create active buttons and sliders that overlapand please don't hang stuff off the edge of the screen.If you click the right mouse button the will pop up. Click cancel or hit the right option add textbutton again to remove them. You can to aZeST interface by selecting the first button. The mostimportant feature however is the ability to save GFA code todisk.disk. You can save the complete ZeST interface with your owncreation or just the procedure associated with your interface. .ZSTextensionEach time you save code to disk another file with a is saved and can later be reloaded should you wish tochange or continue work on your interface. You can also save the to disk for inclusion in your own programs.ZeST graphic logo ruler option test optionYou may find the handy when trying to line up boxesand buttons, or try the to manipulate the sliders Scanand push buttons! allows you to keep and delete any element.Most ZeST procedures contain explanations ofkey variables and instructions on where to includeyour own source code but I must assume a workingknowledge of GFA and therefore a basic understanding I can't teach you how toprogram but I can certainly make the job easier!of the listings this program saves. Feel free tocontact me on or on Compuserve 73030,3562 GEnie - D.Becker8.Auto ZeST is freeware, you can copy it, share it with friends, use it in your own programs, sell it through the user group andupload it to your local BBS systems. If you do use ZeST in oneof your own programs I would appreciate a copy...David Becker, 211-7291 Moffatt RoadRichmond, British Columbia, CanadaV6Y 1X9 0$ 6\, @"000> ( ((    (RR66"""" NF. .H4F444R66"""" NF. .HR 44D D D D D"""".4ddddddddZ,,,,f₈"""".f    ~ R66"""" NF. .H4F4fR66"""" NF. .HR 4f PH$B (,B (N $B 4&RʂfX`T PH& "$& >*<,,,,4"""".**J66"""" NF. .H4F4866"""" NF. .HR 46,,,,"""".  ܠRF66"""" NF. .H4F4 RF66"""" NF. .HR 4$>`F((2222T222222222222p22222222T222224 *~ f`((@4*$B 8~| \V1111 29 27 608 222 1117 46 108 60 207 1117 62 108 76 207 1117 78 108 92 207 1117 94 108 108 207 1117 110 108 124 207 1117 126 108 140 207 1117 142 108 156 207 1117 158 108 172 207 1117 174 108 188 207 1117 190 108 204 207 1117 206 108 220 207 1117 222 108 236 207 1117 238 108 252 207 1117 254 108 268 207 1117 270 108 284 207 1117 286 108 300 207 1117 302 108 316 207 1117 318 108 332 207 1117 334 108 348 207 1117 350 108 364 207 1117 366 108 380 207 1117 382 108 396 207 1117 398 108 412 207 1117 414 108 428 207 1117 430 108 444 207 1117 446 108 460 207 1117 462 108 476 207 1117 478 108 492 207 1117 494 108 508 207 1117 510 108 524 207 1117 526 108 540 207 1117 542 108 556 207 1117 558 108 572 207 1117 574 108 588 207 1113 46 63 587 97 1114 29 239 608 295 1112 44 257 110 278 1112 112 257 179 278 1112 181 257 248 278 1112 250 257 317 278 1112 319 257 386 278 1112 388 257 455 278 1112 457 257 524 278 1112 526 257 593 278 1119 < 73 273 1119 << 138 274 1119 >> 208 274 1119 > 282 274 1119 <> 344 274 1119 >< 414 274 1119 - 486 274 1119 .. 552 270 1118 30 309 608 385 1113 46 321 587 348 1117 47 357 587 374 PROCEDURE text_entry_box(max_length%,upper_y%) ' Here's a quick and simple text entry box for use with the ZeST interface. ' Simply pass the maximum length (max_length%) of the text string (string$) ' and the upper_y% coordinate for the top of the text entry box. ' The display will be automatically centered for you. ' -------------------------------------------------------------------------- ' max_length% for text input cannot exceed 74 characters or be less than 0 IF max_length%>74 OR max_length%<0 THEN max_length%=74 ENDIF ' upper_y% for top of text entry box cannot be more than 350 or less then 0 IF upper_y%<0 OR upper_y%>350 THEN upper_y%=350 ENDIF ' -------------------------------------------------------------------------- ' calculate the box width in relation to the maximum text string length l_side%=INT(639-(max_length%*8))/2 r_side%=639-l_side% ' -------------------------------------------------------------------------- ' store the screen section where the text entry box will be drawn GET l_side%-27,upper_y%-2,r_side%+27,upper_y%+52,putback$ ' -------------------------------------------------------------------------- ' draw a platform and place a text box inside based on the calculations GOSUB zest_button(l_side%-25,upper_y%,r_side%+25,upper_y%+50) GOSUB zest_text_box(l_side%-15,upper_y%+10,r_side%+15,upper_y%+40) ' -------------------------------------------------------------------------- ' calculate the correct postion of the string within the text window x_pos%=l_side% y_pos%=upper_y%+31 ' -------------------------------------------------------------------------- ' make sure the input string starts out empty and display the cursor string$="" TEXT x_pos%,y_pos%,CHR$(95) ' -------------------------------------------------------------------------- DO ' continuously test for a keypress (don't forget upper and lower case!) KEYTEST key IF key<>0 THEN SELECT key CASE 1835021,7471117,275906573,270270477 ' RETURN or ENTER key ' exit loop if the return key is pressed and string$ contains text EXIT IF TRIM$(string$)<>"" CASE 6356992,274792448 ' UNDO key string$="" ' clear string$ and exit loop when undo key is pressed EXIT IF TRIM$(string$)="" CASE 4915200,273350656 ' LEFT KEY CASE 5046272,273481728 ' RIGHT KEY CASE 917512,269352968 ' BACKSPACE key ' remove only the last character of string$ IF LEN(string$)>0 THEN string$=LEFT$(string$,(LEN(string$)-1)) TEXT x_pos%,y_pos%,string$+CHR$(95)+SPACE$(max_length%-LEN(string$)) ENDIF CASE 65563,268501019 ' ESC key ' clear string$ when ESC is pressed string$="" TEXT x_pos%,y_pos%,string$+CHR$(95)+SPACE$(max_length%-LEN(string$)) DEFAULT ' if string length will not be exceeded then add the character pressed IF LEN(string$) Since the ZeST GFA interface code was introduced I have had many, many letters and phone calls asking for more! As of this writing you can find: CRISSCROSS (othello/gomuku/go hybrid game) ZeST DRAW POKER (Draw poker, slot machine and high card game) POKER SQUARED (Solitaire poker game) and of course the ZeST DESKTOP (calendar, database, paint and typewriter) on both of the major online services as well as many local BBS systems. Introduction -------------------------------------------------> Other software authors are at this moment developing programs that incorporate the ZeST look and feel. Many have expanded the original simple GFA source code and added their own bells and whistles. I even saw a colour version at the last computer show! I encourage development and enhancement of the original concept. ZeST was originally an experiment in emulating the 'look and feel' of the NeXT computers graphic user interface. The ZeST interface can provide a quick and easy 'front end' to your existing code or act as a simple alternative to learning the complexities of GEM dialogs, resources, windows, etc. Many new users to the ST may have basic code left over from other computers. With a little conversion and the ZeST interface you can have your original creations up and running on the ST in hours! The first GFA code listing included with the ZeST DESKTOP still required patience together with trial and error to write the button_press routines and design the screen just right. I think I can relieve you of this burden. Introducing AUTO ZeST, a utility that completely automates the creation of ZeST screens, front ends, windows, buttons, boxes and sliders! Kind of like a poor man's NextStep in GFA. AUTO ZeST will save authentic GFA code to disk that can then be merged right into the GFA editor. AUTO ZeST will run on all ST platforms with a monochrome monitor. Please disable the CPU cache on the MegaSTe and run at 8 or 16mhz. What makes up a ZeST interface? ----------------------------------------------------> ZeST Windows...............not unlike a GEM window with a title bar at the top and a close button on the far upper left. ZeST windows cannot be moved but may contain any number of buttons, sliders, text boxes, etc. ZeST Buttons...............A 3D pushbutton that can be pressed with the left mouse and will in turn activate your own code. You can add text right over top of a button. ZeST Text Boxes............Carved inset box with a white background for text or graphic output. ZeST Info Boxes............Carved inset box with desktop background. Can be layered with other boxes or buttons for interesting three dimensional displays. ZeST Line Boxes............Thin carved inset line box for surrounding and highlighting other buttons, boxes and text. ZeST Lines.................Single horizontal or vertical carved lines. ZeST Sliders...............Not unlike GEM slider boxes with movable sliding buttons inside a carved slot. ZeST Platforms.............Raised platforms look like buttons but are usually much larger and are not active. They can contain buttons, boxes, sliders, etc. Using Auto ZeST to create and edit a ZeST interface -----------------------------------------------------------> When first run, you will be greeted with the information box. Press any key or click the mouse to remove it (you can recall it later with the HELP key). You are now in the EDIT screen which should be blank with the desktop background. Clicking the RIGHT mouse button will call up the OPTION buttons but first lets draw a window... ...(click CANCEL if you popped up the OPTION buttons) Hold down the LEFT mouse button and with it depressed drag the mouse down and to the right. The outline of the new box follows the arrow until you let go of the mouse button. The CHOICE buttons now appear on one side of the screen. The box outline you have just drawn can now become a ZeST window with a title bar on the top and a close box to the left, a ZeST button that moves in and out, a ZeST text box for displaying alphanumerics, an info box carved into the desktop, a line box cut only at the border, a platform or a ZeST slider. (We will talk about vertical and horizontal lines a bit later). Click on the type of box you wish to create or click CANCEL and draw the outline box over again! You can continue adding buttons and boxes to your screen until the cows come home. If you wish to create a row of buttons or boxes and have them line up side by side then use the ARROW keys. Every time you press an arrow key the outline of the previous box will appear in the direction of the arrow and you will be asked what type should be created. By alternately pressing the arrow keys and mouse button you can create some pretty impressive button panels very quickly. Another neat feature for creating multiple copies of anything is to draw a giant outline box and then when the choice buttons pop up press any number on the numeric keypad (far right side of your keyboard). A little indicator box will appear showing the number of copies set and the direction they will be created. You can change the creation direction from 'up-down' to 'left-right' by pressing the number again and again. Hit any other key to cancel the copies. With the copy indicator set, simply click on the type of button you want to create and the giant outline box will fill with the desired number in the desired direction. Error checking is kept to a bare minimum throughout the program so don't create active buttons and sliders that overlap and please don't hang stuff off the edge of the screen. Drawing a line is easy. Just make sure that the horizontal or vertical sides of your outline box are overlapping and then click the line button. If you are new at using the mouse this may take a bit of practice. You can create horizontal or vertical slider boxes simply by defining an outline box and clicking the slider button. The sliding gadget will always default to 1/5 the length of the entire slider box. If you define a long outline box up and down you will get a vertical slider and if you define a long outline box side to side you will get a horizontal slider. Makes sense! A safety buffer holds the last creation command and if you hit the UNDO key you can cancel and remove your LAST creation. Let's click the RIGHT mouse button and look at the OPTION buttons. ---------------------------------------------------------------------> Add text --------> You can add text anywhere on you screen by clicking the first option. Text is usually used to mark the tops of buttons. After activating text creation the mouse will disappear. Simply type your text using the keyboard and then you will be able to move it around with the mouse. ESC will clear the text. When you have the text centered on the button (or wherever) just press the LEFT mouse to put it down. UNDO removes the LAST text placement if you make a mistake. You can continue placing text on the screen until you click the RIGHT mouse button. If you hold the ALTERNATE key when placing a text character down you will set the "carbon copy" flag and another copy of the same character will appear at the mouse position ready for placement in a different location. This is handy when creating ruler displays for sliders or text boxes. If you hold down the CONTROL key when placing a text character down you will set the "increment" flag and a copy of the next letter or number higher will appear at the mouse position. Great for creating calendars or calculator keypads! Hitting BACKSPACE or ESC clears either flag. Save with ZeST code -------------------> The most important feature of Auto ZeST is the ability to save code to disk. The second option saves the entire ZeST interface code (all of the procedures that are needed to control the drawing and manipulation of boxes, buttons and windows) along with the custom routines and procedures needed to reproduce and control your interface creation. Everything will be saved in one tidy package. Just merge the listing into the GFA editor and run! Save procedures only --------------------> The third option is to save only the procedure associated with your custom interface. With this option you can create secondary screens that can be imported and called from your existing ZeST program. The procedure will take on the name of the file chosen with the file_selector and includes both the draw and mouse control routines in one. Save the ZeST logo ------------------> The fourth option saves the ZeST logo code to disk so that you can reproduce this graphic in your own program. The procedure contains an explanation on how to easily PUT the logo anywhere. In fact, all the code written by Auto ZeST is commented with remarks pointing to key variables and functions. I must however assume a basic understanding and a working knowledge of GFA3. The ZeST code will not teach you programming but will certainly make it easier. Create a new screen -------------------> The option to create a new screen will destroy anything previously created, use this option with caution. You don't have to press this button when Auto ZeST is first run. You are ready to create from the moment the EDITOR desktop first appears. Toggle ruler on/off -------------------> The ruler will be toggled on and off with each press of this button. You may find the ruler helpful when lining up boxes on either side of the screen. While the ruler is on you will not have access to the very top or the far left of the screen, keep this in mind. Test this interface -------------------> Option number seven allows you to physically manipulate the screen. Push the buttons, try out the sliders, have some fun! The right mouse button exits back to the edit screen. Scan this interface -------------------> Scan each piece of your interface with confirmation. As each element of your interface appears the ST will wait for either a left mouse button press to go ahead or a right mouse button press to bypass and delete the displayed element. Just hit the 'Q' key to abort this "step by step scan" and continue as normal. Load an interface -----------------> Every time you save ZeST code to disk, Auto ZeST quietly saves a secondary file with the same name and the extension (.ZST). You can reload previously saved interfaces by choosing this option and double clicking on any (.ZST) file when the selector comes up. You will lose any work up to that point when loading a new ZeST screen. If you hold down the ALTERNATE key when selecting your (.ZST) file you can scan each piece of the interface with confirmation just as you would using the "scan this interface" option explained above. (You only have to hold down ALT until the first box appears). Quit to the desktop -------------------> You will be prompted to confirm that you wish to exit the program. Cancel ------> Just in case you bring up the option menu by mistake. Help! -----> Pressing the HELP key while in the edit screen brings up a few reminders that may come in handy. I hope Auto ZeST is just what you've been looking for. It is FREEWARE so don't hesitate to copy it, use ZeST in your own programs, share it with friends, sell it through the user group or upload it to local BBS systems. If you do use ZeST in one of your own programs I would appreciate a copy. Dave Becker 211-7291 Moffatt Road Richmond, British Columbia Canada, V6Y 1X9 Compuserve 73030,3562 GEnie D.Becker8 Hints and comments on version 1.0 ---------------------------------> - the safety buffer is purged everytime you toggle the ruler on or off, begin creating a new outline box or when you exit the text editor. - the mouse is shaped like a crosshair during edit, an arrow during button selection and a pointing hand during a screen test. - if you define an outline box for multiple copies the last shape created is sometimes slightly smaller or larger than the rest. This is because the number of copies did not divide evenly into the size of the outline box . - save ONLY the (.ZST) file by using the extension .ZST instead of .LST when the file_selector appears. - you can click the right mouse button a second time to CANCEL and remove either the OPTION or CHOICE buttons when they appear. - ZeST buttons, sliders, platforms, windows, etc. are meant to be placed on the desktop background fill. They look crummy when placed on a stark white background. Hints and comments on version 1.1 ---------------------------------> - a new algorithm now calculates multiple copies more precisely. Even though multiple elements will now always be the same width it is possible there will be a few pixels left over at the end of any outline box. Auto ZeST calculates the size of each copy as close as is possible and then throws away the extra few pixels at the end. It is unusual for these few empty pixels to be noticeable but if you wish to add the little fellas to the last button (as Auto ZeST did in version 1.0) then hold down the ALTERNATE key when clicking on the choice buttons. - some cosmetic changes were made to centre the OPTION box buttons. - the CHOICE buttons can now appear on either side of the edit screen depending on the location of your outline box. - the UNDO flag did not always reset, this has been fixed. - I've included a GFA listing with Auto ZeST called ENTRY.LST Simply merge this file into the GFA editor. It's a quick and simple text entry box procedure for use with the ZeST interface. - I've also included a .ZST file called DEMO.ZST that you can load directly into the Auto ZeST editor. It's kind of a graphic equalizer demo that I thought you might get a kick out of! Check out my other programs online ------------------------------------> Utilities ---------> SmartDate ............. set your ST system date automatically Dingbat! .............. use graphic characters to rename files Inksaver .............. set your Deskjet to draft on bootup FastFix .............. turn of key click and fix screen dumps Monitor Magic ......... green/amber colour screen emulator System Sentry ......... protect your ST and hard drive Applications ------------> Fontswap .............. Postscript typeface substitution for DTP OnSchedule ............ Create schedules and print shifts 3 ways F11 ................... Function key template designer Exchange Rate Printer.. Create custom currency exchange rate charts Jiffydraw ............. Quick and easy DEGAS mono paint program Portfolio Partner ..... Portfolio/ST compatible address book cdBASE ................ Simple and fun compact disk database ZeST Desktop Demo ..... calendar, database, typewriter and paint AutoZeST .............. create ZeST interfaces automatically for GFA ScanMate .............. Organize & print frequencies for PRO scanners Entertainment -------------> PaiGow Poker .......... Play against the ST or over the phone line Frustration! .......... Two player word search game Desktop Repeat ........ SIMON like desk accessory game CrissCross ............ Go/Othello/Gomuku hybrid game ZeST Draw Poker ....... High card, slot machine and draw poker Poker Squared ......... Poker solitaire, very addictive Online Backgammon ..... Play over the modem or against the computer Television Toonz ...... Guess these original themes from past shows GridLock .............. This toy provides stress relief thru software. Stay tuned ----------> dbWriter .............. Full featured text processor with mail merge, spell check, page preview and more! Your History! ......... Print historical happenings, holidays and famous events for any day (even your birthday!) . (ON.. DESK_TOP )ONGIF_INFO -ONMEMBERS TXT bM(. *ON.. (ONDTOPINF DOC `M!0 THE DESKTOP.INF FILE by Richard Karsmakers Everybody must have noticed a file called DESKTOP.INF on some of his disks. Some of you will probably now what it does, but some of you will just as probably not know what it does or even what it is. In this article I will try to tell all I know about this file, and about the special manipulations that are possible with it. The file can be loaded into an editor or word processor that does not use WP mode and then it can be edited and saved back. If you custom desktop crashes your system, just reset it with another (normal) disk in the drive and all will be OK. The DESKTOP.INF file is created whenever you select "SAVE DESKTOP" under the "OPTIONS" menu from the GEM desktop. We will see what is stored in a while. The ST's DESKTOP.INF file is actually very limited. The Apple Mac DESKTOP file contains a lot more information so it seems, and it is also hidden in the directory (obviously, people don't want you to mess around with it). Every time you start up your ST system, reset it, or switch between the color resolutions, the DESKTOP.INF is loaded into memory, and its parameters are used. More about that later. Let's look at a standard DESKTOP.INF file. This was created by resetting the system and immediately selecting "SAVE DESKTOP" (in Germany, this is "ARBEIT SICHERN"). #a000000 #b000000 #c7770007000600070055200505552220770557075055507703111103 #d #E 1B 03 #W 00 00 04 03 43 10 00 @ #W 00 00 0D 08 2A 0B 00 @ #W 00 00 0E 09 2A 0B 00 @ #W 00 00 0F 0A 2A 0B 00 @ #M 00 00 00 FF A FLOPPY DISK@ @ #M 00 01 00 FF B FLOPPY DISK@ @ #T 00 06 02 FF TRASH@ @ #F FF 04 @ *.*@ #D FF 01 @ *.*@ #G 03 FF *.APP@ @ #G 03 FF *.PRG@ @ #F 03 04 *.TOS@ @ #P 03 04 *.TTP@ @ Let's now have a look at the individual lines. All lines are preceeded by a "#" and a identifier, followed by some parameters. #a000000 RS232 Parameters ^^^^^^ |||||| ||||| Bit8 0 = On, 1 = Off |||| Rts/Xo 0 = Off/Off, 1 = Off/On |||| 2 = On/Off , 3 = On/On ||| Bits 0 = 8, 1 = 7, 2 = 6, 3 = 5 || Parity 0 = No Parity, 1 = Odd, 2 = Even | Baud 0 = 9600, 1 = 4800, 2 = 1200, 3 = 300 Duplex 0 = Full, 1 = Half This line is only in use when a desk accessory is loaded that is supplied on the ST System Disks. This can be recognized under "DESK" by the name "RS232 Configuration". #b000000 ^^^^^^ Printer Configuration Parameters |||||| ||||| Paper 0 = Tractor Feed, 1 = Single Sheets |||| Port 0 = Centronics, 1 = RS232 ||| Quality 0 = Draft, 1 = Maximal || Dots 0 = 1280, 1 = 960 | Color 0 = B/W, 1 = Color Type 0 = Dot Matrix, 1 = Daisywheel This line is only in use when a desk accessory is loaded that is supplied on the ST System Disk. It can be recognized by the option "Install Printer" under the "DESK" menu. #c7770007000600070055200505552220770557075055507703111103 ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ ^ | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | | Yellow | | | | | | | | | | | | | | No system color | | | | | | | | | | | | | No system color | | | | | | | | | | | | Magenta | | | | | | | | | | | No system color | | | | | | | | | | Bluegreen | | | | | | | | | No system color | | | | | | | | Light Grey | | | | | | | No system color | | | | | | No system color | | | | | No system color | | | | Blue | | | No system color | | Red | Black White The last seven characters on this line have nothing to do with colors. Their meaning is the following: 3111103 ^^^^^^^ ||||||| ||||| Two hexadecimal digits of key repeat rate ||| Two hexadecimal digits of key repeat time || Clock 0 = Off, 1 = On | Key click 0 = Off, 1 = On Mouse speed 0-4 (4 is fastest) This line is only activated when you use the desk accessory called "Control Panel". By activating the control panel, these colors and other settings are taken over by GEM. #E 1B 03 Extras ^^ ^^ || || || Two digits of a hexadecimal number, of which the || individual bits have the following meaning: || 0-2 = No meaning || 3 = Confirm copy (0 = No, 1 = Yes) || 4 = Confirm delete (0= No, 1 = Yes) || 5-6 = Sort on.... (00 = Name, 01 = Date, || 10 = Size, 11 = Type) || 7 = Show as.... (0 = Icons, 1 = Text) Resolution: 01 = 320*200 or monochrome 02 = 640*200 or monochrome 03 = Monochrome or 320*200 This line is always activated, and the values contained in it can be changed by using the "VIEW" and "OPTIONS" pull-down menus from the GEM desktop. In the DESKTOP.INF file created on the disk of ST NEWS, you'll notice that the resolution is set to '02': Medium res is activated when color monitors are used, whereas monochrome (of course) is installed on monochrome monitors. #W 00 00 04 03 43 10 00 @ Windows #W 00 00 0D 08 2A 0B 00 @ #W 00 00 0E 09 2A 0B 00 @ #W 00 00 0F 0A 2A 0B 00 @ ^^ ^^ ^^ ^^ ^^ ^^ ^^ ^ || || || || || || || | || || || || || || || Name of opened window || || || || || || Value of vertical scrollbar || || || || || Heighth of the window || || || || Width of the window || || || Y-Position || || X-Position || Value of vertical slider bar Value of horizontal slider bar This is one of the more interesting parts to manipulate. More about that later. The values of 'X-Position' and 'Width of the Window' have to be multiplied by 8 to get the actual pixels; 'Y- Position' and 'Height of the window' have to be multiplied by either 8 (color) or 16 (monochrome) for this. This easily explains why it is impossible to position the window sizes by pixels (like the MacIntosh). Up to four windows can be defined. #M 00 00 00 FF A FLOPPY DISK@ @ Disk Drive Icons #M 00 01 00 FF B FLOPPY DISK@ @ ^^ ^^ ^^ ^^ ^ ^^^^^^^^^^^ || || || || | ||||||||||| || || || || | Name of the Icon || || || || Drive Identifier || || || || || Icon Type (hexadecimal) || || 00 = Disk Drive, 01 = Folder || || 02 = Trashcan , 03 = Program || || 04 = File || Y-Position (multiply with 40 b/w || or 20 color to get real position || and add 20) (Hex) X-Position (multiply with 80 for real position) (Hex) #T 00 06 02 FF TRASH@ @ Trashcan ^^ ^^ ^^ ^^ ^^^^^ || || || || ||||| || || || || Name of the Trashcan || || || || || Icon Type (hexadecimal) (For types || || please look on the previous page) || Y-Position (see previous page) X-Position (see previous page) #G 03 FF *.APP@ @ GEM Application #G 03 FF *.PRG@ @ ^^ ^^ ^^^ || || ||| || || Extension of file that is GEM App. || See note on page 12 Type of Icon for GEM App. (see previous page) #F 03 04 *.TOS@ @ TOS Application ^^ ^^ ^^^ || || ||| || || Extension of file that is TOS App. || See note on page 12 Type of Icon for TOS App. (see two pages back) #P 03 04 *.TTP@ @ TTP Application ^^ ^^ ^^^ || || ||| || || Extension of file that is TTP App. || See note on page 12 Type of Icon for TTP App. (see two pages back) Note to a relatively unknown byte (mostly $FF) in the lines for TTP-, GEM-and TOS applications: According to Mr. Wilfred Kilwinger (see "Did you know that....") in his article in SAG Magazine Volume 2 Issue 5, this byte indicated that the program uses AES if $FF, and GEMDOS/TOS when $04. Not surely known, though. Now for some practical manipulations. I will not talk about all the logical manipulations (changing the obvious first couple of lines), but I will just look at two new manipulations that have not yet been treated in any other magazines. The first one is a way to make sure that only ONE file displayed in the directory of a disk. Is doesn't matter which other files are on the disk - they will simply not be displayed. The trick: After each window line, you can see one '@' sign. This is the place where the name of the current (sub-)directory is placed when a window (or several windows) was opened when you SAVEd the desktop. If you give this line a program name rather than a (sub-)directory name (upper-or lowercase doesn't matter), only the program with that name is displayed! Take care not to throw away the '@', and leave a space between the name and that character. Example: #W 00 00 04 03 43 10 00 @ becomes #W 00 00 04 04 43 10 00 A:\ST_NEWS.PRG @ The second technique I'd like to discuss is the one that takes care that you see only a limited amount of file on the disk. For example, you can have the following modes: - Show Folders and Programs (no other files) - Show Data files and Programs (no folders) - Show Programs (no folders and other files) The secret is hidden in the following two lines: #F FF 04 @ *.*@ #D FF 01 @ *.*@ If you delete the first one, only folders and PRG icons will be displayed. If you delete the second, only data files and PRG icons will be displayed. And if you delete both, only PRG icons are displayed. I almost forgot one small third manipulation. For example, it is possible to make programs executable that have different extensions that just .TOS, .TTP, .APP or .PRG. For example, if you want all files that end on .AAA to be treated as program files as well, you should add the following line: #G 03 FF *.AAA@ @ The 'G' stands for GEM application, and thus makes the file exactly the same as any .APP or .PRG file. The 03 defines a PRG icon (you can change that as well), and the FF probably means that the program uses GEM. But do not expect that you can now just rename all files to .AAA extensions! The files need to have proper executable program formats to be used correctly. That's all for now. If you think you have found a new kind of DESKTOP.INF manipulation technique, please do not hesitate to write to me (or maybe you can even write an article about it!). Originally published in ST NEWS Volume 2 Issue 6. . .ON.. (ONGIF DOC `TMz G I F (tm) Graphics Interchange Format (tm) A standard defining a mechanism for the storage and transmission of raster-based graphics information June 15, 1987 (c) CompuServe Incorporated, 1987 All rights reserved While this document is copyrighted, the information contained within is made available for use in computer software without royalties, or licensing restrictions. GIF and 'Graphics Interchange Format' are trademarks of CompuServe, Incorporated. an H&R Block Company 5000 Arlington Centre Blvd. Columbus, Ohio 43220 (614) 457-8600 Page 2 Graphics Interchange Format (GIF) Specification Table of Contents INTRODUCTION . . . . . . . . . . . . . . . . . page 3 GENERAL FILE FORMAT . . . . . . . . . . . . . page 3 GIF SIGNATURE . . . . . . . . . . . . . . . . page 4 SCREEN DESCRIPTOR . . . . . . . . . . . . . . page 4 GLOBAL COLOR MAP . . . . . . . . . . . . . . . page 5 IMAGE DESCRIPTOR . . . . . . . . . . . . . . . page 6 LOCAL COLOR MAP . . . . . . . . . . . . . . . page 7 RASTER DATA . . . . . . . . . . . . . . . . . page 7 GIF TERMINATOR . . . . . . . . . . . . . . . . page 8 GIF EXTENSION BLOCKS . . . . . . . . . . . . . page 8 APPENDIX A - GLOSSARY . . . . . . . . . . . . page 9 APPENDIX B - INTERACTIVE SEQUENCES . . . . . . page 10 APPENDIX C - IMAGE PACKAGING & COMPRESSION . . page 12 APPENDIX D - MULTIPLE IMAGE PROCESSING . . . . page 15 Graphics Interchange Format (GIF) Page 3 Specification INTRODUCTION 'GIF' (tm) is CompuServe's standard for defining generalized color raster images. This 'Graphics Interchange Format' (tm) allows high-quality, high-resolution graphics to be displayed on a variety of graphics hardware and is intended as an exchange and display mechanism for graphics images. The image format described in this document is designed to support current and future image technology and will in addition serve as a basis for future CompuServe graphics products. The main focus of this document is to provide the technical information necessary for a programmer to implement GIF encoders and decoders. As such, some assumptions are made as to terminology relavent to graphics and programming in general. The first section of this document describes the GIF data format and its components and applies to all GIF decoders, either as standalone programs or as part of a communications package. Appendix B is a section relavent to decoders that are part of a communications software package and describes the protocol requirements for entering and exiting GIF mode, and responding to host interrogations. A glossary in Appendix A defines some of the terminology used in this document. Appendix C gives a detailed explanation of how the graphics image itself is packaged as a series of data bytes. Graphics Interchange Format Data Definition GENERAL FILE FORMAT +-----------------------+ | +-------------------+ | | | GIF Signature | | | +-------------------+ | | +-------------------+ | | | Screen Descriptor | | | +-------------------+ | | +-------------------+ | | | Global Color Map | | | +-------------------+ | . . . . . . | +-------------------+ | ---+ | | Image Descriptor | | | | +-------------------+ | | | +-------------------+ | | | | Local Color Map | | |- Repeated 1 to n times | +-------------------+ | | | +-------------------+ | | | | Raster Data | | | | +-------------------+ | ---+ . . . . . . |- GIF Terminator -| +-----------------------+ Graphics Interchange Format (GIF) Page 4 Specification GIF SIGNATURE The following GIF Signature identifies the data following as a valid GIF image stream. It consists of the following six characters: G I F 8 7 a The last three characters '87a' may be viewed as a version number for this particular GIF definition and will be used in general as a reference in documents regarding GIF that address any version dependencies. SCREEN DESCRIPTOR The Screen Descriptor describes the overall parameters for all GIF images following. It defines the overall dimensions of the image space or logical screen required, the existance of color mapping information, background screen color, and color depth information. This information is stored in a series of 8-bit bytes as described below. bits 7 6 5 4 3 2 1 0 Byte # +---------------+ | | 1 +-Screen Width -+ Raster width in pixels (LSB first) | | 2 +---------------+ | | 3 +-Screen Height-+ Raster height in pixels (LSB first) | | 4 +-+-----+-+-----+ M = 1, Global color map follows Descriptor |M| cr |0|pixel| 5 cr+1 = # bits of color resolution +-+-----+-+-----+ pixel+1 = # bits/pixel in image | background | 6 background=Color index of screen background +---------------+ (color is defined from the Global color |0 0 0 0 0 0 0 0| 7 map or default map if none specified) +---------------+ The logical screen width and height can both be larger than the physical display. How images larger than the physical display are handled is implementation dependent and can take advantage of hardware characteristics (e.g. Macintosh scrolling windows). Otherwise images can be clipped to the edges of the display. The value of 'pixel' also defines the maximum number of colors within an image. The range of values for 'pixel' is 0 to 7 which represents 1 to 8 bits. This translates to a range of 2 (B & W) to 256 colors. Bit 3 of word 5 is reserved for future definition and must be zero. Graphics Interchange Format (GIF) Page 5 Specification GLOBAL COLOR MAP The Global Color Map is optional but recommended for images where accurate color rendition is desired. The existence of this color map is indicated in the 'M' field of byte 5 of the Screen Descriptor. A color map can also be associated with each image in a GIF file as described later. However this global map will normally be used because of hardware restrictions in equipment available today. In the individual Image Descriptors the 'M' flag will normally be zero. If the Global Color Map is present, it's definition immediately follows the Screen Descriptor. The number of color map entries following a Screen Descriptor is equal to 2**(# bits per pixel), where each entry consists of three byte values representing the relative intensities of red, green and blue respectively. The structure of the Color Map block is: bits 7 6 5 4 3 2 1 0 Byte # +---------------+ | red intensity | 1 Red value for color index 0 +---------------+ |green intensity| 2 Green value for color index 0 +---------------+ | blue intensity| 3 Blue value for color index 0 +---------------+ | red intensity | 4 Red value for color index 1 +---------------+ |green intensity| 5 Green value for color index 1 +---------------+ | blue intensity| 6 Blue value for color index 1 +---------------+ : : (Continues for remaining colors) Each image pixel value received will be displayed according to its closest match with an available color of the display based on this color map. The color components represent a fractional intensity value from none (0) to full (255). White would be represented as (255,255,255), black as (0,0,0) and medium yellow as (180,180,0). For display, if the device supports fewer than 8 bits per color component, the higher order bits of each component are used. In the creation of a GIF color map entry with hardware supporting fewer than 8 bits per component, the component values for the hardware should be converted to the 8-bit format with the following calculation: = *255/(2** -1) This assures accurate translation of colors for all displays. In the cases of creating GIF images from hardware without color palette capability, a fixed palette should be created based on the available display colors for that hardware. If no Global Color Map is indicated, a default color map is generated internally which maps each possible incoming color index to the same hardware color index modulo where is the number of available hardware colors. Graphics Interchange Format (GIF) Page 6 Specification IMAGE DESCRIPTOR The Image Descriptor defines the actual placement and extents of the following image within the space defined in the Screen Descriptor. Also defined are flags to indicate the presence of a local color lookup map, and to define the pixel display sequence. Each Image Descriptor is introduced by an image separator character. The role of the Image Separator is simply to provide a synchronization character to introduce an Image Descriptor. This is desirable if a GIF file happens to contain more than one image. This character is defined as 0x2C hex or ',' (comma). When this character is encountered between images, the Image Descriptor will follow immediately. Any characters encountered between the end of a previous image and the image separator character are to be ignored. This allows future GIF enhancements to be present in newer image formats and yet ignored safely by older software decoders. bits 7 6 5 4 3 2 1 0 Byte # +---------------+ |0 0 1 0 1 1 0 0| 1 ',' - Image separator character +---------------+ | | 2 Start of image in pixels from the +- Image Left -+ left side of the screen (LSB first) | | 3 +---------------+ | | 4 +- Image Top -+ Start of image in pixels from the | | 5 top of the screen (LSB first) +---------------+ | | 6 +- Image Width -+ Width of the image in pixels (LSB first) | | 7 +---------------+ | | 8 +- Image Height-+ Height of the image in pixels (LSB first) | | 9 +-+-+-+-+-+-----+ M=0 - Use global color map, ignore 'pixel' |M|I|0|0|0|pixel| 10 M=1 - Local color map follows, use 'pixel' +-+-+-+-+-+-----+ I=0 - Image formatted in Sequential order I=1 - Image formatted in Interlaced order pixel+1 - # bits per pixel for this image The specifications for the image position and size must be confined to the dimensions defined by the Screen Descriptor. On the other hand it is not necessary that the image fill the entire screen defined. LOCAL COLOR MAP Graphics Interchange Format (GIF) Page 7 Specification A Local Color Map is optional and defined here for future use. If the 'M' bit of byte 10 of the Image Descriptor is set, then a color map follows the Image Descriptor that applies only to the following image. At the end of the image, the color map will revert to that defined after the Screen Descriptor. Note that the 'pixel' field of byte 10 of the Image Descriptor is used only if a Local Color Map is indicated. This defines the parameters not only for the image pixel size, but determines the number of color map entries that follow. The bits per pixel value will also revert to the value specified in the Screen Descriptor when processing of the image is complete. RASTER DATA The format of the actual image is defined as the series of pixel color index values that make up the image. The pixels are stored left to right sequentially for an image row. By default each image row is written sequentially, top to bottom. In the case that the Interlace or 'I' bit is set in byte 10 of the Image Descriptor then the row order of the image display follows a four-pass process in which the image is filled in by widely spaced rows. The first pass writes every 8th row, starting with the top row of the image window. The second pass writes every 8th row starting at the fifth row from the top. The third pass writes every 4th row starting at the third row from the top. The fourth pass completes the image, writing every other row, starting at the second row from the top. A graphic description of this process follows: Image Row Pass 1 Pass 2 Pass 3 Pass 4 Result --------------------------------------------------- 0 **1a** **1a** 1 **4a** **4a** 2 **3a** **3a** 3 **4b** **4b** 4 **2a** **2a** 5 **4c** **4c** 6 **3b** **3b** 7 **4d** **4d** 8 **1b** **1b** 9 **4e** **4e** 10 **3c** **3c** 11 **4f** **4f** 12 **2b** **2b** . . . The image pixel values are processed as a series of color indices which map into the existing color map. The resulting color value from the map is what is actually displayed. This series of pixel indices, the number of which is equal to image-width*image-height pixels, are passed to the GIF image data stream one value per pixel, compressed and packaged according to a version of the LZW compression algorithm as defined in Appendix C. Graphics Interchange Format (GIF) Page 8 Specification GIF TERMINATOR In order to provide a synchronization for the termination of a GIF image file, a GIF decoder will process the end of GIF mode when the character 0x3B hex or ';' is found after an image has been processed. By convention the decoding software will pause and wait for an action indicating that the user is ready to continue. This may be a carriage return entered at the keyboard or a mouse click. For interactive applications this user action must be passed on to the host as a carriage return character so that the host application can continue. The decoding software will then typically leave graphics mode and resume any previous process. GIF EXTENSION BLOCKS To provide for orderly extension of the GIF definition, a mechanism for defining the packaging of extensions within a GIF data stream is necessary. Specific GIF extensions are to be defined and documented by CompuServe in order to provide a controlled enhancement path. GIF Extension Blocks are packaged in a manner similar to that used by the raster data though not compressed. The basic structure is: 7 6 5 4 3 2 1 0 Byte # +---------------+ |0 0 1 0 0 0 0 1| 1 '!' - GIF Extension Block Introducer +---------------+ | function code | 2 Extension function code (0 to 255) +---------------+ ---+ | byte count | | +---------------+ | : : +-- Repeated as many times as necessary |func data bytes| | : : | +---------------+ ---+ . . . . . . +---------------+ |0 0 0 0 0 0 0 0| zero byte count (terminates block) +---------------+ A GIF Extension Block may immediately preceed any Image Descriptor or occur before the GIF Terminator. All GIF decoders must be able to recognize the existence of GIF Extension Blocks and read past them if unable to process the function code. This ensures that older decoders will be able to process extended GIF image files in the future, though without the additional functionality. Graphics Interchange Format (GIF) Page 9 Appendix A - Glossary GLOSSARY Pixel - The smallest picture element of a graphics image. This usually corresponds to a single dot on a graphics screen. Image resolution is typically given in units of pixels. For example a fairly standard graphics screen format is one 320 pixels across and 200 pixels high. Each pixel can appear as one of several colors depending on the capabilities of the graphics hardware. Raster - A horizontal row of pixels representing one line of an image. A typical method of working with images since most hardware is oriented to work most efficiently in this manner. LSB - Least Significant Byte. Refers to a convention for two byte numeric values in which the less significant byte of the value preceeds the more significant byte. This convention is typical on many microcomputers. Color Map - The list of definitions of each color used in a GIF image. These desired colors are converted to available colors through a table which is derived by assigning an incoming color index (from the image) to an output color index (of the hardware). While the color map definitons are specified in a GIF image, the output pixel colors will vary based on the hardware used and its ability to match the defined color. Interlace - The method of displaying a GIF image in which multiple passes are made, outputting raster lines spaced apart to provide a way of visualizing the general content of an entire image before all of the data has been processed. B Protocol - A CompuServe-developed error-correcting file transfer protocol available in the public domain and implemented in CompuServe VIDTEX products. This error checking mechanism will be used in transfers of GIF images for interactive applications. LZW - A sophisticated data compression algorithm based on work done by Lempel-Ziv & Welch which has the feature of very efficient one-pass encoding and decoding. This allows the image to be decompressed and displayed at the same time. The original article from which this technique was adapted is: Terry A. Welch, "A Technique for High Performance Data Compression", IEEE Computer, vol 17 no 6 (June 1984) This basic algorithm is also used in the public domain ARC file compression utilities. The CompuServe adaptation of LZW for GIF is described in Appendix C. Graphics Interchange Format (GIF) Page 10 Appendix B - Interactive Sequences GIF Sequence Exchanges for an Interactive Environment The following sequences are defined for use in mediating control between a GIF sender and GIF receiver over an interactive communications line. These sequences do not apply to applications that involve downloading of static GIF files and are not considered part of a GIF file. GIF CAPABILITIES ENQUIRY The GCE sequence is issued from a host and requests an interactive GIF decoder to return a response message that defines the graphics parameters for the decoder. This involves returning information about available screen sizes, number of bits/color supported and the amount of color detail supported. The escape sequence for the GCE is defined as: ESC [ > 0 g (g is lower case, spaces inserted for clarity) (0x1B 0x5B 0x3E 0x30 0x67) GIF CAPABILITIES RESPONSE The GIF Capabilities Response message is returned by an interactive GIF decoder and defines the decoder's display capabilities for all graphics modes that are supported by the software. Note that this can also include graphics printers as well as a monitor screen. The general format of this message is: #version;protocol{;dev, width, height, color-bits, color-res}... '#' - GCR identifier character (Number Sign) version - GIF format version number; initially '87a' protocol='0' - No end-to-end protocol supported by decoder Transfer as direct 8-bit data stream. protocol='1' - Can use an error correction protocol to transfer GIF data interactively from the host directly to the display. dev = '0' - Screen parameter set follows dev = '1' - Printer parameter set follows width - Maximum supported display width in pixels height - Maximum supported display height in pixels color-bits - Number of bits per pixel supported. The number of supported colors is therefore 2**color-bits. color-res - Number of bits per color component supported in the hardware color palette. If color-res is '0' then no hardware palette table is available. Note that all values in the GCR are returned as ASCII decimal numbers and the message is terminated by a Carriage Return character. Graphics Interchange Format (GIF) Page 11 Appendix B - Interactive Sequences The following GCR message describes three standard EGA configurations with no printer; the GIF data stream can be processed within an error correcting protocol: #87a;1 ;0,320,200,4,0 ;0,640,200,2,2 ;0,640,350,4,2 ENTER GIF GRAPHICS MODE Two sequences are currently defined to invoke an interactive GIF decoder into action. The only difference between them is that different output media are selected. These sequences are: ESC [ > 1 g Display GIF image on screen (0x1B 0x5B 0x3E 0x31 0x67) ESC [ > 2 g Display image directly to an attached graphics printer. The image may optionally be displayed on the screen as well. (0x1B 0x5B 0x3E 0x32 0x67) Note that the 'g' character terminating each sequence is in lower case. INTERACTIVE ENVIRONMENT The assumed environment for the transmission of GIF image data from an interactive application is a full 8-bit data stream from host to micro. All 256 character codes must be transferrable. The establishing of an 8-bit data path for communications will normally be taken care of by the host application programs. It is however up to the receiving communications programs supporting GIF to be able to receive and pass on all 256 8-bit codes to the GIF decoder software. Graphics Interchange Format (GIF) Page 12 Appendix C - Image Packaging & Compression The Raster Data stream that represents the actual output image can be represented as: 7 6 5 4 3 2 1 0 +---------------+ | code size | +---------------+ ---+ |blok byte count| | +---------------+ | : : +-- Repeated as many times as necessary | data bytes | | : : | +---------------+ ---+ . . . . . . +---------------+ |0 0 0 0 0 0 0 0| zero byte count (terminates data stream) +---------------+ The conversion of the image from a series of pixel values to a transmitted or stored character stream involves several steps. In brief these steps are: 1. Establish the Code Size - Define the number of bits needed to represent the actual data. 2. Compress the Data - Compress the series of image pixels to a series of compression codes. 3. Build a Series of Bytes - Take the set of compression codes and convert to a string of 8-bit bytes. 4. Package the Bytes - Package sets of bytes into blocks preceeded by character counts and output. ESTABLISH CODE SIZE The first byte of the GIF Raster Data stream is a value indicating the minimum number of bits required to represent the set of actual pixel values. Normally this will be the same as the number of color bits. Because of some algorithmic constraints however, black & white images which have one color bit must be indicated as having a code size of 2. This code size value also implies that the compression codes must start out one bit longer. COMPRESSION The LZW algorithm converts a series of data values into a series of codes which may be raw values or a code designating a series of values. Using text characters as an analogy, the output code consists of a character or a code representing a string of characters. Graphics Interchange Format (GIF) Page 13 Appendix C - Image Packaging & Compression The LZW algorithm used in GIF matches algorithmically with the standard LZW algorithm with the following differences: 1. A special Clear code is defined which resets all compression/decompression parameters and tables to a start-up state. The value of this code is 2**. For example if the code size indicated was 4 (image was 4 bits/pixel) the Clear code value would be 16 (10000 binary). The Clear code can appear at any point in the image data stream and therefore requires the LZW algorithm to process succeeding codes as if a new data stream was starting. Encoders should output a Clear code as the first code of each image data stream. 2. An End of Information code is defined that explicitly indicates the end of the image data stream. LZW processing terminates when this code is encountered. It must be the last code output by the encoder for an image. The value of this code is +1. 3. The first available compression code value is +2. 4. The output codes are of variable length, starting at +1 bits per code, up to 12 bits per code. This defines a maximum code value of 4095 (hex FFF). Whenever the LZW code value would exceed the current code length, the code length is increased by one. The packing/unpacking of these codes must then be altered to reflect the new code length. BUILD 8-BIT BYTES Because the LZW compression used for GIF creates a series of variable length codes, of between 3 and 12 bits each, these codes must be reformed into a series of 8-bit bytes that will be the characters actually stored or transmitted. This provides additional compression of the image. The codes are formed into a stream of bits as if they were packed right to left and then picked off 8 bits at a time to be output. Assuming a character array of 8 bits per character and using 5 bit codes to be packed, an example layout would be similar to: byte n byte 5 byte 4 byte 3 byte 2 byte 1 +-.....-----+--------+--------+--------+--------+--------+ | and so on |hhhhhggg|ggfffffe|eeeedddd|dcccccbb|bbbaaaaa| +-.....-----+--------+--------+--------+--------+--------+ Note that the physical packing arrangement will change as the number of bits per compression code change but the concept remains the same. PACKAGE THE BYTES Once the bytes have been created, they are grouped into blocks for output by preceeding each block of 0 to 255 bytes with a character count byte. A block with a zero byte count terminates the Raster Data stream for a given image. These blocks are what are actually output for the Graphics Interchange Format (GIF) Page 14 Appendix C - Image Packaging & Compression GIF image. This block format has the side effect of allowing a decoding program the ability to read past the actual image data if necessary by reading block counts and then skipping over the data. Graphics Interchange Format (GIF) Page 15 Appendix D - Multiple Image Processing Since a GIF data stream can contain multiple images, it is necessary to describe processing and display of such a file. Because the image descriptor allows for placement of the image within the logical screen, it is possible to define a sequence of images that may each be a partial screen, but in total fill the entire screen. The guidelines for handling the multiple image situation are: 1. There is no pause between images. Each is processed immediately as seen by the decoder. 2. Each image explicitly overwrites any image already on the screen inside of its window. The only screen clears are at the beginning and end of the GIF image process. See discussion on the GIF terminator. ICTARI PROGRAMMERS GROUP ======================== CURRENT LIST OF MEMBERS February 1995 Martyn Armitage 101 South Terrace, Wales Bar, Sheffield S31 8QL Tel. 0909 773564 Keith Baines 8 Lumley Court, Denmark Avenue, London SW19 4HQ Ian & Mark Baker 256 Lower Road, Great Bookham, Surrey KT23 4DL Tel. 0372 454875 Nick Bates 17 Elliott Close, Forches estate, Barnstaple N Devon, EX32 8EW Tel. 0271 24633 Mark Blackwood 64 Chantry Road, Moseley, Birmingham, B73 8DJ Te. 027 4490936 Paul Brookes 32 Dudsbury Road, West Parley, Ferndown Dorset, BH22 8RE Jamie-Lee Burrows 220 Broadlands Drive, Lawrence Weston Bristol, Avon, BS11 0PN Tel. 0272 384771 Albert Cartwright 258 Yardley Fields Rd, Stechford, Birmingham B33 8RL Tel. 021 6283710 James Collett Park View Farm, Carlton, Nr Nuneaton, Warks CV13 0DA Internet E-Mail- jrc1@axprl1.rl.ac.uk Martin Cubitt 14 Deepdene Ave, Rayleigh, Essex SS6 9LG Robert Darling 11b Turketel Rd, Folkstone, Kent CT20 2PA Tel. 0303 245203, BBS No 0303 249306 Richard Davey 10 Oak Drive, Portishead, Bristol, Avon BS20 8QS Tel. 0275 843241 James Davidson Wood Farm House, Whichford, Shipston-on-Stour Warwickshire, CV36 5PG Tel. 01608 684308 Paul Ditchfield 499 Owen, Ashworth North, Maghull, Liverpool L31 1HW Tel. 051 4730303 Extn 4364 Richard Evans 3 Gervis Crescent, Parkstone, Poole, Dorset BH14 0LR Tel. 0202 744151 E-Mail. JANET : mud08@keele.ac.uk James Ford 4 Berceau Walk, Watford, Herts, WD1 3BL Tel. 0923 248762 Vimal Goricha 29 Abbey Way, Bradville, Milton Keynes MK13 7AQ Tony Harris 36A Howard Close, Braintree, Essex, CM7 6DS Roland Henriksson Myggvagen 28, Skovde, Sweden, 54165 Tel. 46 500 438295 George Hodgson 4a Millicent Close, Hednesford, Staffs WS12 4BJ Tel. 0543 423804 Kenneth Hughes 220 Broadlands Drive, Lawrence Weston Bristol, Avon, BS11 0PN Tel. 0272 384771 Jefferson Humber 16 Kingfisher Close, Carisbrooke Park Newport, Isle of Wight, PO30 5XS Tel. 0983 526046 Steven Jordan 38 Wylam, Mill Park, Bracknell, Berks RG12 8XS Tel. 0344 427581 Terry King 172 Spencers Croft, Harlow, Essex, CM18 6JR Tel. 01279 864026 John Levon 12 St Johns Ave, Wakefield, W Yorks WF1 2RE Marten Lindstrom Savenasvagen 24, S-932 31 Skelleftehamn Sweden John Logan 9 Myrtlefield Park, Belfast, BT9 6NE Tel. 0232 660302 Godwin Lotsu Parc Des Saules 14/2, Wavre, Belgium, 1300 Tel. 010 228996 Adrian Lovatt Flat C, 5 Bower Street, Harrogate, N Yorks HG1 5BQ Ralph Lovesy 12 Bell Lane, Syresham, Northants, NN13 5HP Tel. 0280 850450 Iain McLeod 15 Regis Court, Barnton, Edinburgh, EH4 6RG Martin Milner 1 Portland Avenue, Burton on Trent, Staffs DE14 3GD Tel. 021 7046256 (Day) 0283 500944 (Evening) Jason Murdoch 13 Woodmoor, Finchampstead, Wokingham Berks, RG11 3TT Simon Oke 10 Symn Lane, Wotton-under-edge, Gloucs GL12 7BG Stan Otterburn 35 The Avenue, Pity me, Durham, DH1 5DY Carl Pattinson 40 Silverdale Place, Newton Ayecliffe County Durham, DL5 7DZ Kevin Preece 17 Chislet way, Grange Park, Tuffley Gloucester, GL4 0QQ Gary Priest 167 Ludlow Rd, Itchen, Southampton SO19 2EL Christopher Reeder 101 Icknield Walk, Royston, Herts SG8 7LJ Tel. 0763 247913 Raymond Reid 10 Daviot Drive, Hilton, Inverness, IV2 4UL Alan Richardson 55 Alderbrook Road, Clapham South, London SW12 8AD Tel. 081 675 1866 Simon Rigby 116 Rosmead St, Newbridge Rd, Hull HU9 2TE Geoff Smith 6 Humber Road, Beeston, Nottingham, NG9 2EF John Stevenson Flat 4, St Marys College, Fenham Hall Drive Newcastle upon Tyne, NE4 9YH Peter Strath 75 Cavendish Road, Highams Park, London E4 9NQ Scott Stringer 42 Chartwell Street, Christchurch, 8009 New Zealand James Taylor 12 West Drive, Cleadon, Sunderland, T & W SR6 7SJ Tel. 091 5362165 Derek Warren 31 Lyster Rd, Fordingbridge, Hants, SP6 1QY 01425 655642 Martyn Wells 86 Cornwall Road, Kettering, Northants NN16 8PE Tel. 0536 520240 Jonathan White 20 Fryent Close, Black Rod, Bolton BL6 5BU (This is not a complete list as some members do not want to be listed) . 7ON.. INTERES2PAS .LWKM_AGAINPAS {IPLA11RM PAS ULMARKS PAS \mMEGABLASPAS MPMONEYMANPAS vEODDNUMS PAS JPODDS PAS  !~PROGRAM Double_Your_Money; { Program to calculate how long it will take for an user definable amount of money invested in a bank (at a definable interest rate) to double. Written by Roy McPartland to demonstrate the WHILE..DO functions in Pascal. Saved on disk as INTEREST.PAS 23/10/91 } USES CRT; VAR Count : Real; Investment : Real; Interest_Rate : Real; Added_Interest : Real; Orig_Investment: Real; PROCEDURE Asking_for_input_figures; BEGIN CLRSCR; WRITELN ('Please enter amount to be invested'); READLN (Orig_Investment); WRITELN ('Now enter the interest rate as a decimal'); READLN (Interest_Rate); END; PROCEDURE Calculating_the_time; BEGIN Count := 0; Investment := Orig_Investment; WHILE Investment < (Orig_Investment * 2) DO BEGIN Added_Interest := Interest_Rate * Investment; Investment := Investment + Added_Interest; Count := Count + 1 END; END; PROCEDURE Display_Answers; BEGIN CLRSCR; WRITELN ('The investment takes ',Count:4:1,' years to double'); END; BEGIN {Main Program} Asking_for_Input_Figures; Calculating_the_time; Display_Answers; DELAY (3000); WHILE Orig_investment <> -99 Do BEGIN Asking_for_Input_Figures; Calculating_the_time; Display_Answers; DELAY (3000); END; END.PROGRAM Conversion_Chart; { This program displays a conversion chart between miles and kilomtric distances. Written By Roy McPartland 15/10/91. Saved on disk as KM_AGAIN.PAS } USES CRT; CONST Miles_to_Km = 1.6093; VAR Miles : Real; Km : Real; BEGIN CLRSCR; WRITELN (' Miles to Kilometres chart'); WRITELN; Miles := 10; Km := Miles * Miles_to_Km; WRITELN (Miles:3:0,' Miles equals ',Km:3:3,' Km'); REPEAT Miles := Miles + 10; Km := Miles * Miles_to_Km; WRITELN (Miles:3:0,' Miles equals ',Km:3:3,' Km'); UNTIL (Miles = 100); END.PROGRAM Pool_Draws; { This program, written by Roy McPartland, is to help in checking Football Pools entries. The user is invited to type in the goals scored by each team in a match. The computer decides which of four categories the result falls in and the decision is output. The program then prompts the user for next matches' scores. This continues until a negative number is entered. At that stage the program will output 6 pieces of infomation, then end. } USES CRT; VAR Home_Team_Scr : Integer; {Variable for the home team's score} Away_Team_Scr : Integer; {Variable for the away team's score} Home_Win : Real; {The home team win counter variable} Away_Win : Real; {The likewise away win variable} Score_Draw : Real; {As above, but for score draws} No_Scr_Draw : Real; {Again as above, but for no score draws} Match_Count : Real; {Counts the amount of matches entered} Total_Points : Real; {Variable for the total points gained} PROCEDURE Value_Of_Variables; {States the begining values of variables} BEGIN Home_Win := 0; Away_Win := 0; Score_Draw := 0; No_Scr_Draw := 0; Home_Team_Scr := 0; Match_Count := 0; END; PROCEDURE Intro_Page; {Displays who wrote the program} BEGIN CLRSCR; GOTOXY (2,0); WRITELN ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'); GOTOXY (26,10); WRITELN ('P O O L S C H E C K E R'); GOTOXY (26,11); WRITELN ('~~~~~~~~~~~~~~~~~~~~~~~~~'); GOTOXY (63,23); WRITELN ('By Roy McPartland'); GOTOXY (1,24); WRITELN ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'); DELAY (3000); END; PROCEDURE Calculate_Points; {Calculates the total points by multiplying the amount of wins in each category by the appropiate figure } BEGIN Total_Points := (Home_Win) + (Away_Win * 1.5) + (No_Scr_Draw * 2) + (Score_Draw * 3); END; PROCEDURE Calculate_Categories; {If the home team's score is more than or is equal to 0 the program asks the user for the way team's score} BEGIN IF Home_Team_Scr < 0 THEN BEGIN {Begining of loop} GOTOXY (31,12); WRITELN ('End of Entries'); DELAY (700); END; {End of loop} IF Home_Team_Scr >= 0 THEN BEGIN {Start of loop} GOTOXY (21,6); WRITE ('Now enter the away teams score '); READLN (Away_Team_Scr); GOTOXY (31,12); {Screen area to display answer} IF Home_Team_Scr > Away_Team_Scr THEN BEGIN {Start of sub loop} Home_Win := Home_Win + 1; WRITELN ('Home win'); END; {End of sub loop} IF Home_Team_Scr < Away_Team_Scr THEN BEGIN Away_Win := Away_Win + 1; WRITELN ('Away win'); END; IF Home_Team_Scr + Away_Team_Scr = 0 THEN BEGIN No_Scr_Draw := No_Scr_Draw + 1; WRITELN ('No score draw'); END; IF (Home_Team_Scr = Away_Team_Scr) AND (Home_Team_Scr > 0) THEN BEGIN Score_Draw := Score_Draw + 1; WRITELN ('Score draw'); END; Match_Count := Match_Count + 1; DELAY (700); {Holds the answer on screen for 7/10s of a second} END; {End of loop} END; PROCEDURE Input_The_Scores; {Allows user to enter the teams' results} BEGIN WHILE Home_Team_Scr >= 0 DO BEGIN {Begining of loop} CLRSCR; GOTOXY (26,1); WRITELN ('FOOTBALL POOLS CHECKER'); GOTOXY (26,2); WRITELN ('**********************'); GOTOXY (20,4); WRITE ('Please enter the home teams score '); READLN (Home_Team_Scr); {User enters the home team's score} Calculate_Categories; {Calls the preceding procedure of that name} END; {End of loop} END; PROCEDURE Display_Categories; BEGIN Calculate_Points; {Calls the preceding procedure of that name} CLRSCR; GOTOXY (2,0); WRITE ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'); GOTOXY (19,6); WRITELN ('From a total number of matches of ',Match_Count:3:0); GOTOXY (24,10); WRITELN (Home_Win:5:0,' were home wins'); GOTOXY (24,11); WRITELN (Away_Win:5:0,' were away wins'); GOTOXY (24,12); WRITELN (No_Scr_Draw:5:0,' were no score draws'); GOTOXY (24,13); WRITELN (Score_Draw:5:0,' were score draws'); GOTOXY (18,17); WRITELN ('Giving a total number of points of ',Total_Points:4:1); GOTOXY (1,24); WRITE ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~') END; BEGIN { Main program starts here } Value_Of_Variables; {Call the variable stating procedure} Intro_Page; {Display the 'Welcome message'} Input_The_Scores; {Calls the inputting procedure} Display_Categories; {Displays the final answers} END. { End of main program } { STRUCTURE OF PROGRAM State the value of the variables. Display the welcome screen. Ask the user to input the home team's score. If this score if less than 0 call the result table making procedure. If the home team's score is more than 0 or is equal to 0 call the procedure that ask for the away team's score. This procedure will also calculate what category of result has been entered, display the appropiate answer, adds 1 to the appropiate variable, e.g. Home_Win for a home win, and adds 1 to the match counter. The computer then calls up the result table procedure which immediately callls up the procedure that calculates the total amount of points gained from the matches entered. It then returns to the result procedure, displays the proper answers and quits to the main program. As there are no more procedures to 'run' the main program ends itself. }PROGRAM Exam_Marks; { Program to input a student's exam mark and display the following messages Excellent if the mark's more than 70 Good if the mark's between 50 and 70 Pass if the mark's between 40 and 49 Fail if the mark is less than 40 Written by Roy Mc P, who's here today 13/11/91. } USES CRT; VAR Input_Score : Integer; PROCEDURE Input_Marks; BEGIN CLRSCR; WRITELN ('Please enter the score achieved'); READLN (Input_Score); END; PROCEDURE Calculations; BEGIN IF (Input_Score > 70) THEN WRITE ('Excellent'); IF (Input_Score < 70) > 50 THEN WRITE ('Good'); IF (Input_Score < 49) > 40 THEN WRITE ('Pass'); IF (Input_Score < 40) THEN WRITE (FAIL); END; BEGIN Input_Marks; Calculations; END. PROGRAM Countdown; { This program uses the DELAY function in Turbo Pascal to set a delay time of 1000 miliseconds (1 second) between displaying numbers for a 'rocket launch sequence'. Written by Roy McPartland, ace space- fighter vehicle type thingie commander, 15/10/91. Saved on disk as MEGABLAS.PAS } USES CRT; VAR Number : Integer; BEGIN {Main Program}; CLRSCR; WRITELN ('What number do you want to countdown from?'); READLN (Number); CLRSCR; GOTOXY (30,11); WRITELN ('T minus ',Number,' seconds'); REPEAT Number := Number - 1; DELAY (1000); GOTOXY (30,11); WRITELN ('T minus ',Number,' seconds '); UNTIL (Number = 0); GOTOXY (32,13); WRITELN ('============='); GOTOXY (32,14); WRITELN ('Lift Off!!!!!'); GOTOXY (32,15); WRITELN ('============='); END. PROGRAM A_Workers_Wage; { Program to work out a wage with the tax rate and pay rate set as constants but the HOURS are variable By Roy McPartland ?/9/91 } USES CRT; CONST PAY_RATE = 3.50; TAX_RATE = 0.25; VAR HOURS : Real; TOTAL_PAY : Real; REAL_PAY : Real; TAXED_PAY : Real; PROCEDURE Display_Text; BEGIN WRITELN ('Please enter the number of hours worked'); WRITELN ('~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'); READLN (HOURS); END; PROCEDURE Calculating_the_Pay; BEGIN TOTAL_PAY:= HOURS * PAY_RATE; TAXED_PAY:= TOTAL_PAY * TAX_RATE; REAL_PAY:= TOTAL_PAY - TAXED_PAY; END; PROCEDURE Displaying_the_Results; BEGIN WRITELN ('The wage received is ',REAL_PAY:5:2); END; BEGIN Display_Text; Calculating_the_Pay; Displaying_the_Results; END. .PROGRAM Odd_Numbers; { This program displays all the odd numbers between 0 and 39 using the REPEAT & UNTIL commands. Written by Roy Mc Partland 15/10/91, Saved as ODDNUMS.PAS } USES CRT; VAR Number : Real; BEGIN {Main program starts here} Number:= 1; WRITELN (Number:2:0); REPEAT Number:= Number + 2; WRITELN (Number:2:0); UNTIL (Number = 39); END.PROGRAM Conversion_Chart; USES CRT; CONST Miles_to_Km = 1.82; VAR Miles : Real; Km : Real; BEGIN Miles := 10; Km := Miles * Miles_to_Km; WRITELN (Miles:3:0,' Miles equals ',Km:3:0,' Km); REPEAT Miles := Miles + 10; WRITELN (Miles:3:0,' Miles equals ',Km:3:0,' Km); UNTIL (Miles = 100); END.. FON.. MAD_BOMB GONSUB-ROUT TONI. GON.. EONHI DAT MAD BAS $PMartin Cubitt 6586 ms 12390 martin 14604 martin 14604 martin 14604 martin 14604 martin 14604 martin 14604 martin 14604 martin 14604 LionpoulosPd6d  ------------------- ----------------------------- --------------------------------- *********************************( * THE MAD BOMBER - AUG 89 *( * by Martin Cubitt *( *-------------------------------*( * Points/bomb,No.bombs,Bonus * ********************************* --------------------------------- ----------------------------- -------------------@H$( ),!H( ),#PPB(),"NB(),"GG(),!X(),!Y():P1:P2P1:P3P1 ::::ͦ::w,::::HIGH$HI.DAT:FT::,:():(cHIGH$,)nInsert MAD BOMBER disc then press left mouse button or press right mouse buttonto write new high score table.::M::L:z #,cHIGH$:YcxI :#,dH$(cxI):#,!dH(cxI):cxI:# :::REVENGE OF THE MAD BOMBER:::::"Martin Cubitt August 1989 via STOS:::PWelcome to the REVENGE OF THE MAD BOMBERbased on the Activision game KABOOM for;the Atari console system.::xThe mad bomber enjoys nothing more thanwhen one of his bombs explodes. He dropsthem from a height so when they hit the;ground... Obviously you do not approve(oh no you don't!) of this so armed withyour three buckets you set out to catchthe bombs before they hit the ground. As;(an insentive to catch the bombs you areawarded points depending on the level,aswell as the fact that you lose a bucketif one explodes. For every 5000 points;)qyou have a bucket returned. Maximum of 3buckets are allowed. Your bucket/s onlymove left or right via the mouse.::Good luck - Press MOUSE BUTTON.::::HALL OF:crA9:cjA$FAME!:'::c"H$(!dH()):c"H$(c"H$,(c"H$)):(c"H$)H$(H$,)L(c"H$)c"H$(0,(c"H$))c"H$j:cjA$>dH$( )(.,(dH$( ))) (!dH( ))<:cjA$:::::%cxI :cjA$ dH$(cxI)(.,(dH$(cxI))) (!dH(cxI)) :cjA$::cxI:::P R E S S M O U S E K E Y:k:::ަ:A9:A$M A D:'::A9 :A$BOMBER:':::' Martin Cubitt 8/89. Written using STOSNI:I:,Z,I:I,.:ަȜu0:I:#PPB(I),"NB(I),"GG(I):I:LI:SC:RN:R:BX()<:TPP1nS1:S2:S3:CT :CB: , :PRESS MOUSE KEY!::::():::ަ:,P3,P3::b:A$(!H( )):A$(A$,(A$)):A$(0,(A$))A$:,:(A$,)vPPB#PPB(R):NB"NB(R):GG"GG(R):,:###;RN,BD:I:!X(I):!Y(I):I:X:a:b :XI:()XI$^BMW:BD0g **************************************** Bomb to drop?0 ****************************************"BDNB.BMW:BMWGGCT::!X(CT)BX:!Y(CT):ICT:bp:BD:BMW:CTCT0 **************************************** Move bomber0 ****************************************"¢BDNBRǢ(R)XI:()XInOXBX:OXOXXIR:OXXI:BX:J֢OX XI:BCBXOXb 0 **************************************** Move bombs0 ****************************************ICBxL!X(I):M!Y(I):MM(R):L0(MP3(MP3!Y(CB)TPXXXX(CB, , ):XXXXXXXXX*&!Y(I)M:bpN0I:ICTCTCB209 ****************************************V Caught bomb0W ****************************************NXCB:MYPS:[<YMYPS:[ZYPSTP$[,X,YPS,0]::SCSCPPB:bb: :CTCBlLCBmLCT!X(L)!X(L):!Y(L)!Y(L):L:mDCT:CT::FL0 ****************************************X\Йa:M!Y():L!X():L vFL:XXXX(CB, , ):XXXXXXXXX <:R:RN:R FR:P1dP1:P2:P3L::L::L: :LCBz:L,!X(L),!Y(L),::L,!X(L),!Y(L),: :L,!X(L),!Y(L),::L,!X(L),!Y(L),::L,!X(L),!Y(L),::L:L:LCT RLP1RN:P1:P2:P3:R:RN:RR(RNRN0LI2:: ,BX,,|:::-: :LILI:TPTP:LI*ʨ ::P: Ӵ::ͦԨ,::ަ:::,,,:,,,:, (1,1,150)e150:, (1,1,150)e150:::,(1,1,90):, (1,2,190)٠:x: ߨ:,,i,: :,,i,::,,i,: :,,i,::,,i,: ::4:::Another game? (Y/N):<A$:A$(A$):A$Y A$N :I *SC!H(I)(I:I:::BMX:You have a high score!::In at position ; I;.:$Enter your name (20 characters max.)8$NAME:;A$:A$$F.(A$)Please read CAREFULLY!:3ILI:!H(L)!H(L):H$(L)H$(L):L68!H(I)SC:H$(I)A$tB(HIGH$,)(Insert MAD BOMBER disc then press mouse.:::BCJH#,HIGH$:I :#,H$(I):#,!H(I):I:#:IJK:*** DISC ERROR ***:::!Could be full of write protected.:::7Try another disc or move tab then press a mouse button.:::B.LMMVI :!H(I)M:MM:H$(I) MAD BOMBER!:I:!H( )':H$( )THE MAD BOMBER:C'::':2'cbSZ(:SZPX'cZA1$cjA$:cRA1(cjA$):cRA1((cbSZ))~'t'A1$:A1(A$):A1$A1$(A$,A1,) :A1:A1$A1$(A$,):A1(A1$):A1SZA$:A$A1$:'D'tcRA1cRA1:cRA1(cbSZcRA1)$'~cJA2(cZA1$):N :c2A6((cZA1$,cJA2,))@:(cZA1$,cJA2,) `cBA3A9A9:A1,A3: :cBA3:'؛c2A6c2A6: if !(33) then Z+1(26)T'7c2A6:$c:A7:c*A2$:c:A7:c2A6:`'c:A7:c*A2$:cRA1,crA9c:A7:c*A2$; :c:A7*'cRA1cRA1:cJA2::fN  A , A A ,A A,AAAAA,A A,A A,A A,A AfN!BBBB ,B B,B B,BBBBB,B B,B B,B B,BBBB fN" CCC ,C C,C ,C ,C ,C ,C C, CCC fN#DDD ,D D ,D D,D D,D D,D D,D D ,DDD fN$EEEEE,E ,E ,EEEE ,E ,E ,E ,EEEEEfN%FFFFF,F ,F ,FFFF ,F ,F ,F ,F fN& GGG ,G G,G ,G GG,G G,G G,G G, GGG fN'H H,H H,H H,HHHHH,H H,H H,H H,H HfN(IIIII, I , I , I , I , I , I ,IIIIIfN)JJJJJ, J , J , J , J , J ,J J , JJJ fN*K K,K K ,K K ,KK ,K K ,K K ,K K ,K KfN+L ,L ,L ,L ,L ,L ,L ,LLLLLfN,MM MM,M M M,M M M,M M,M M,M M,M M,M MfN/N N,N N,NN N,N N N,N N N,N NN,N N,N NfN0 OOO ,O O,O O,O O,O O,O O,O O, OOO fN1PPPP ,P P,P P,PPPP ,P ,P ,P ,P fN2 QQQ ,Q Q,Q Q,Q Q,Q Q,Q Q Q,Q QQ, QQQQfN3RRRR ,R R,R R,RRRR ,RR ,R R ,R R ,R RfN4 SSS ,S S,S , SSS , S, S,S S, SSS fN6TTTTT, T , T , T , T , T , T , T fN9U U,U U,U U,U U,U U,U U,U U,U UfN;V V,V V,V V,V V,V V,V V, V V , V fN>W W,W W,W W,W W,W W,W W W,WW WW,W WfNAX X,X X, X X , X , X , X X ,X X,X XfNCY Y,Y Y, Y Y , Y , Y , Y , Y ,Y fNEZZZZZ, Z, Z , Z , Z , Z ,Z ,ZZZZZfNF ! , ! , ! , ! , ! , ! , , ! &aLIa,a,a$a,X,P1,S1$a,X,P2,S2&aƤ,X,P3,S3:Fb ,BX,,:BDNBCT Db!Y(CT),BX,,b?@  QQ???ٯRokuU_?"""P&P$@@QU  @+( +XX   @@@@@@@- ?=?<?<???0p`????? @@?3'/w? `@I@!>6X>.@`p 's  p/7/`&`@I`)>6X n.C@Bdr$'rP   @ P @#(N H$4 Xc(} PC0Ppppuw'"wV?ujq\:* sv~`nձqV \쿾־/.7;s~vVnjuqٰ \>*5??{*o`x`x`x`x{{~||||~|~<> <??|<> <> ? * ٩!3-!?!?!!8$"!!"$8!!<"!>!!"<!!!!a!3-!!!q<"!>!q!"<Q? > qqQ ?QqQ>!>0Qq($"6?fs\l43L cw]\Yѱޚt4ltޚ76;=p@Аӳ6wsfY]ݱt4l?3&C@??3}?_@||@x@|3}{|~||~}||~~}|||~|}>>??|><?`٩!3-!?!?!!8$"!!"$8!!<"!>!!"<!!!!a!3-!!!q<"!>!q!"<Q? > qqQ ?QqQ>!>0Qq($"?~>#?q~?gǏg?#~q?gǏ~<ow?ww<w|}}|}}}|}}}~wyp?x~>#?qp?gg?#pq?g~@qoow{?_g{ow{ow{@qw{|}}|}}}~}|}}}}}5{ьkF DZ^wo?={Pߡ c9s1c1c1c09P)@ ƱoD Vn`~Ԫ\x~nf^L~tp4j~xhrf~~xP^@^Hp޾ؾ؊F&0f``THD@*zhn 28\p΀x4B% PZhN@ zrt| 6HZh|nz΄`\ư8PJxHdbrj^jrdx|xlrnzTTvjZD@pnLFflxBzF$: ~tL>JNtHlL>8tXh~jr|nƺȂ^xlpx|zvppfbXVvh jP&fh`~rrh`jvpZd\~¨`~ހʤĄtZllV^Z^fT@NTz`V,Nv*.*MRG%1+3 SPLASH.SAMbhv\tTVtLnlZfLPFFrB`dV\`nvrrbtʔ~b|PNt~`Œ|f~t`~v@LNZtd~|zXʄ>.|`j02FP^X4dlnjưxV@Df|v~d&|fN|dؼh4\:ޚJȸvJ`LvT@,PV\&FfJP<B ~x̖d|6^v`nptzκzrVZbzF,df$6`n88hFR4p|*@ĜxrĆִtؒо@B\hT~ZZjZZPH *L>tlV>xb`֜v||ҾhDp~rV,p^|~xhTD82:LZRRhnNntbdfdBhd8ؾЊĐtF>NZVRzzⶒtxʦr|bL`ZbL:X LL,JrRXVfj~hTrb~T:jjptHLvtPft0 |" HVF$NlZ䤐rZPnb6^h\bvF8>njRt*68Z~v|~j0(lnjjचb<$>TH|Zlvn\\p^ Rj>*zx䲘dnd\ZVl~ZTBltJ`^^t˜ƬrptP8|JLFDvp"TzȺpZjTrvtz~rZHzЎV@^*VD8XvxFV^Ό|䆄ښ~Rx*~ltP|Vv~44>dZ^"zv^\p®vRBfpDRZph`Ơp^rrʢj`^N*THRbljhdF4XTƨvP2(B`VfľprvZrœzv|ĴƀVTnzRFH`Ddxnth\\RPvpzh\f`Xh\^H^xrdPdvδΔxb6"88ptª~|꺄b~nFPRJNRZ``RB:D<:*6rDT6@|fꆎҴ̼ҪpJ`Ddr4.& `^v0B0bpnlD^|؄\`Npj֬j|zlfdV\0NRN4@bn|zZJB:|rhrzdRZTdZ\XdL<<,LNHx.@Zƞ>|`xXƘ^Ԟzj|0N|4D``VlFnbh^\v|tp|Ҿ|tvtLVj|j\Z>8R>6>RX`p|z|jb樀ph|v\v\bXFtZ~\8Vp\^\^J^P~xZPPDPjlʤb6Jt0vzfbbjf~brN|r`ptz`Rfnfv|vh\`jlv|^~nDn\tVdhj|nhpj8jF`hppT``lxd|~´¶|ffdlfX|^ZfxN|xLx|tPv|bnvzrTr|~xttttxtpn~~ΤZf:jnpbn0RxV@8f^R||fh^|xJ~vfhdzhdNtjllL^LTrԼr^bfHlV@>L\~zN^`~ftbpvxjd|xxjflffdnvttx|z`jnxfrlTr`Tnvrxpplzv~btzf\hrf~rdx~|jnT\ZHHpzthVrjXljf|l~llzZxXFTZd6fbN^zbzh~|Tjz6f`Vpnzzv@||xܼnTnbZ:RXxz^fPB:8N|~Z^~\2VZlNVd||tt|fTzjxТprljμn^N>n,PnBlZ\t\zDPN(nztFltRtnҾtXxzhz~fl~”R.\fX:Tx>zJ8\ft`TbvtԌĆ`Hxvz~jn8|LDVN2`6v(H2L[=\prئȟıxtuveZk~NFTMu!\s3X*3C}jpty{yyѕʣ[OZyH{V`XV\EOTUEE~r{FXLDUWd׌Xxeoͥaire{XncQ?Pgi|rvNqs~i}zMrgtYiMltEfb]eec}umkdθ}yy~vrfPN^}tmoaQGRiL?QXexm{}w}}xYucfugdXWnVh[=ItRaT_p]go\Li;Mir@hqddm{~bKOwkkzmmoqmw~]vuus{~vhgq``kpxX{~\l]{ov~uwj|iRz_X]xdwm|t}{}pmhifbR[ry^fikxPgyyqty~tgu}|y}~|{{x{]ZlzQaig]fO`P\v|s[olewv~}tzykhmQYp}jbawqgay^nMCHwTpf]wuz}xqtffhe`cjpmoy~rtqosxwt{yv|}zhre{ykzz{}suhzpm}mzaestUuqxl|y~{rsxekJbi`prS\ctlikZ}X{xyVJJNQ=i~U\qx}fcTzpbum[}{vhxzk_~vx\{ub|jWMM]_Pŧ˛ǩEfwLKfcIPfKZcnaRA)8N4I^WaoM||˨ys~lU}vmwqw{y}X[LGVZUT`xtflyay{z}jnknÛkbKTQVXauw||sxg_[|f\X>\t7]mWN`dV[Wdlyk}woYvlzÈvt~iQAIqIIwF4\Mx]TlQ{jǞtuchxZ}t~5fimȦbjYkIKhAqqp}aTBgSmr}zkzpen}htzjxe~nOhkgxcD>_iKT9@e}\m*]Zwmkru{R\we?WpfpLbF-9=9TIL̤oh?etl~ql[\rs\AluKKqW~k}nb_S_kb}tussia_n\j|oeq|jxqj7aY}Y1Z;vfitx]w~rbyzpplm\k`b]S`}}kl^rzZtYrsuqfhjjkj}y}~qɐgqos~cs~X|pdvac]V^]Got}qqc~rtT_>[\TxulMW[lUzpihlOQW[]?^p8;hhcxi{xclicoyqѩzk~nnZthRPc}f`:MXnRKyvzk`m{ђ`GVL_mv]vc;dMJeX|}j{om|jjU_RQVytvvTwifZqY[6~l|p|iFt_}oi^dtWr|hn~mtFfwxogpkmvxmidpki{xav|xnqzsbdfV``c`XenprjZNhV^sr|n`]afcvuwpyz~voW]Zsqg>Yn+Vyhh}~x~}qlwsefzhppjyupfdl}mTlbus_h~a}quѧz~kq[glkfd_ZHUcNvqrn\}lʲ|[L^]^x~V=hFIag[Pap}}t]FI^]xsecR57CYXjT=?S].K+KiSbFSoK]VyzÔŽĿԻanLZkGL6" G@1c87:Ypbvrf{}z©wzc˃wy~}u|YN8\{C[Rfpm|~}g_]Xr||rhqmf[o`^cgwk\VrnCUx]kw|M`]k{~~eȪw~{w8\WksTLS\W`Rkjib`lxо~}aTX{xjyWAHobIHNZ^arzwhǼyvg{lhyl\kepbTRV\^fh]Wlz~|{n_XKmydqxzr}zWO}Ycu~nwlsfuqygtznkziVZ_^jtpim`brzyqhbppmltxmwXpn\Zbmyywjbvekpbpuwojcskc~}nih}y~fkswubylnvyvep~nqunjlwrjq{xY]epmnUYpkREWY\nxlpvfqzs{x~poxge{mt~yut_]\anokeul}zaLEIgzmvtqiausxpqu}ngt}yjgejajpsstwyy~zw~sovqxxfsuk_cztimz|~|waq|omjzypw~zi_qjbMaovxoani|pmpmx{|~omxoVURqnUZsuedv}ujvrqsX^]]ek~dl{yrʯzq~nQhrfo~siXPD=Cdsfg|bpxy_Daxzo{hlYB.'BAc;dpNLUb^TNEQrsd>?T][eϺƜŠdVePXEKBJKPRUrhZE:8DTINWGYnoƳ~w{pfvr}eXW[mof]Yab\[cx~~wnibesujksnxhYX\blit}x|ytzqhUhvbziXafWkVOWcZW]l{}~p`i~wvnxhY_IN[SOdqt|hdo^kotpgn~|rfadbzº~|mak˟yb]luhznQCXgfotsVVRB\v}efkckxuz|üq}|s|usH2LZAk`?9HbQfVHQvxjhelѻt^z|xΣco\ZzqPWI:\*=?HC^modit|yyvujFOYogDDp`Wc|xzupieol|lntrn}xs}wdTm[Ux~xchwy}}]ist[LjxiqEBAwjxqv`jtVisrptrvoqpbMXqti|i[qog{ckahr[s}kiyYkv~xsfWm}ywzaoQQDPqttxk|pjMN]_ZHG|ijUGIUqxvï|xnfblzhUZXvfGO_[`OFu{qXxz|w}~hqzox~wzXdupxrzqwqRbALa[8M~qtpp{ojYubDDtm`suoDXTTWBm|~tthhSIY^Kn~rOYZae?,Zt]_wirivsrv{wsb[e~tvXZ\brq~zhlvqdgv~yl[Ut~oʿ~qexy~jt{zvkc]XVneZrclmhzfgf^Hacgny|{j]opvo}v}|reX^X@lgZta\XbQbjiuzp{~~r~u|ezhmnXk}u`beumlsugOVyz|wz`fw|tlyiUSON[enplt^aum\|ow\PY`sh^_LO[VNP]qy~m^lznlY:(+FYiZGAPi>SNKczm}mfqN]u|sǶͮygRAXs[L6;7\6C?99EASj~mnΰqo}wtd^dpz|ueI0A[U_Xzx{{{yt||xwwyyz\NnoVmh~oZejtwbkvFQsuje~teąuxip~tkscgZc\kHFDMT\X|me`nz~sҺ{eqa]}~tcDGypMSP]XKdsxrqyqjgWǹy{s~vxrukWk`5Q[zlKgvqpq|uz{yw}mfU`nzi^ritod\qtr}ezvoyzqsfn}yaWI@>Sc{wck~QS{f`{swxljuTif^[ntaXfo`TWaZJU`y{aigqznqqarnoflbxip~rbo}n|}[my_\]{o]`uW[nwedhq{`JQ\cynknht~v~mkhnlV\hq\xpxyweXjzw~ůq{akqfKEJR^{wspanp{ieol_k}lY]etbuyy}}wffttcgaozy\fmb]ix[]jy|x~eYpmdc|yxxm|eYxSb]jhciyoy|nrul|vw|h]tieVSm|WOv{gemzwjrg]^]kz|]r|z~]wrkuo_a|{c|gX\QJCPZgt|w[n}~oaqnzvq{gI-:H8A]}r[Yz`X[IB^|[FX}r`k͹ɽϴ{{xqzthgVND.?KL]\}eK9IZ]X\PicXws|z{~ppfXOY~tj_iusk]m}mmcWeh\k~veojklusk]V\khp|yzyphxYs{zdqsivslrXnxkRSX_[]e|~uslZnyzl~|YQVHZvLeWjW_gwohccae~qj_ckqº{clhb¡{g^~iSwnmTOwsplagRCPbz|legd`hd^ozwym}rluF7Z[BbU@;PY9UTaU`y{k^T\glŰϰed{z||lujriz}wT]QJ7IOQO?Xwebl`q~rsxPIXlymLQxdjyupttjjvwrs{m~rxsmtyyvWc]`_~wfqq~z}tewWhoUS?Fctp|gj~{vpWhlovlfrv}jXUk~}wf`n~cpis~bmmV]g_|jquuyl^ahjv{u~poyr`WCg~v~~xcULttNAaa`TWQWev~|oy˻txrhokr`cgi_[^fgjfiyd]lxrmk}nuusmtqiwSp^oomxZCPZ]zedy~m_e\p~yphcRtnprpdcwRvfol>ozq]\FJ^Ue}put_Xlz\+JmY_z||ktp}j~vVgywwqPIw`_[dop|wwmr|w|qziW]ru}ͧgrqkrye\ryZz{im\X`g]\g_szml||sSV[ihsĶru[odhd}{|oikqw]ZgqVwddvlymL]kjrww}~}wuxtzd`NlqXf|plx~q~hS[gkyxymw}|jkb]]\drryzhS=^y{yhPkxedY[atWKR_\Yhjm{v{~x|z\y{{{p{{g68AQnnXUh|Mhabpu|zn[AMmfYrz~bW`glX:MXId\WKEKOFS}|g|~nVmxr{idbiq{yYB\vZkb{qjmtustlptuozv|}}rz]Xrn`oxoenvtrvhghn{~j{ęunvonqkgfiotvRZ}tXbogS]ZW_|zoijksvgwhwYEdyzUJimiZjeP[kstymvk|tl{|{z~rupxznvvga|^7Yb}~Yo}u{qstylZZmte`~tq}|h\ydy~osis~r|kj}yoXQLN]j~z{zUTs{|vnwj}|r|}qns`jt]dp`\xoVZjlWef`xYgkt{ehiVgtttstu}{z~yt~XkzdYZ~ubams~zyp|}a^t~wy~mbYTmkYw{nZqmv{v~uyw~oz}`h^Sraexgz|}~iggl\XRU^wujtmv|zqjYx{fg]sZy~vtuxvmt|~~zqurckxwyms|{buyq_m}e]equuxxdJZhhpj~vx}|kf}[`exnroxjqyx}s}z{t{u{|ri]nkcLTpz^R|vhryu|g^iaixu{V^tot~awvVmxznb{~subgZMBRdm{lk||xd`zssxq}sxcG;9@T?K}edkkcidR\z~kRjjgXctyuw{q|teRFJR`j`|v`MS_[Zc\jcWq~}y~|y}~x~f]\i}j^oopyfijiqk[hwmn}|owck|lzy}si]Y]fit}xrt}u^xrjn}ggqwcuhmW\`h`\^r}~}oup^p}mjyg`k_PgvVey]atnv|xnwuk|wx~znqq{rbVa~qn|rmuv]S}xt{oeiaibnpdumt~zlo}}}tw}znss|}oj\XSnU\pNLQ_``aUf||wsaekikz~{wxy`{sflyddj^TIZSSX^me|}ws`m}k|~|}^UdriWiu|kithygkintsy~~vpdzj|lmnq\gerrqynryf^zu_mQRS]|nmp~h^covnfuwi\\qzcT{lycpgt~flmXWwmb{kpxyqegkkv{tvnpsfe@`~zzm{~{e^`zfMspnfdS]m~wyzyim~~rkspwikpnecdmoumeqcrxu~vr|i`qmk}kflgyz_tVov\Lbm_qnlxhl`q}{voynDlvwoYohs_ud@hs|moZDXpajis|eUd{a8[wkYbn|yq|imu~}v~t`lvz_P|hlmkoov|lvuhouzsw~kxuV_poxvtxx{knlvkppyjagzo`g_Zmij~xTUVnwrxilrYqstvqm|jf{greykhv{mO]Scdq|xw|||{}wy}phdinchk}mfj||trnpok~oq|yuzulojszoeiv|sldJEfunq\z}~kg^bwiV`]aggpfb}yw{dqbu{pr}cty|sSZUR~{whinlibamxt{}dXcxok|y~j^XLibP^qdkVfRTVP_ck}cs|pr|jfbjmjnMQgqtVuwrtwvzw|~ww{yypy~~szog~y^Tfshfs~t|qogZpzpkv|ís|qmrvelxsvmwaj~v]_njY^ZYb}pjmnvnb~}q}dPr{ZQqwteskRWg~~adncywiyojyrwzqzvw|ohnF[c`{wcwqz~|v}y||po{}yiipsuh|yogw|k|ytqkv}pymkv|ulWUKIWdy}xxzXWwqunxjstj{ovekwbjwbUm}pXNdkQ`[Wxamo{lj|nVgppqpqs~}{{zu~WjwaUUzr``hqv}f_y{}mh_Trtcyv`wttxprqvkxkxy[eZLh|^^~yuj{}qiored]^[oznwvnwxwoiYwzxdf`v`{|}zpu|}x|vfly}{xhisuhoqmamwze^de}xzu}|lV\isymv~|{vzvpughgsjnov{y~z}wzzzr{p}s}~hwfmtu^_m~q^xftxvskahditzty~caonwexbo|roljz}}{r^d`WR]bf~{{tk{vzoiq{uuvwdtweNA@B\MUzrstzlst`d{|m~qzkp~ig}shi}|jWGITgmcgW\nlbvmmvho{vrlrnywzm\Xczkcx||rouuqg[atsmrs}ppwk~y~qnrnffjp{s}~toqxxkgr{uw{nnxvnsyhgdhjferz||ws}~owqrhmtww{uvqeZl|fjttjpopttqhllenymnsnmuxhcjqyspymis~e_}y}nenokbh|ripoqrmb^z||tuynrx}zm{X[`p]_oTT_dYY_ansy{ziY]cjz~z~}}wzfw}lr{|kdpb__hfc^^tdlszgjyzwrdTfq~g\ruv}ovmknt{r}qqmawkxx|xrpimd^znsy|zxtlzjd^Z[]uxotlr``ky|~|}{xtju{rbgtsdptksnzozs`Ubsj}shk|n|wgfnxnvh{qjv]kPgw|xdijqsVvehbc\crxummyyzppih|{zkuxwyniruyxvuyo[xxkvzn|rwu|qf{ronb_`tfsim}~~^^hojxp\c_usnttqjo[|o|woyjWht|wsOjz}~~ljaLUulljo}~z_irSitrgdufvyzyp}{{epv}xzmjux_Mt[kmyqdnyzo}yrt~y|{lqqU\xrm{|to_m{geqzrrspmf]_uxicdbrzq}gaYkxqs~|`uy||rrk}~rbcrc\wtmusk{mX[mxtu|vv{uzp|wy{slj[[oiio|xspvlrpg}~xjzy}yuzxvgn|soszvMFW_k{y}kZr||{{wmcgtzng`cnksuq~q~}yi~}yyoom|t[fv||eV\ass|zqrp{|nVZpn`xvpz{}s}||tki_jqaf~xyzgcdZieqw}u|deylnxzjhmog|X[tz_x~mnotywuvuvxvxsr}ro}vt~~uxwnXkwkp{}szop}ywptvhgq}wrlg~ihvtomoctncg{qiicgqpovwmy|ori|kSftm_uwzta^hztshmo{ursn{kl}itwtkzo{xmeyI^jh}}pyr{xupwkcis}qlmtpf}pt~nl|}zot|xuxqx|qmdYTSal{uqlhsv{e\{|}ynvnyxiuqvxy{nwqsvcXmfVfp_jg_y|cgo|}xwg|y^\px}ovz{~|q\lyd_Z{sffls|yypit||jv|{rs`ozdjowctyuvvrp{u|sinfL\kVxwvsn{vow|tfjof`pzpts{vncs|q|{mnlubzvyz}mnv}w}|mrnahxrr{zgq|vqo{}jfhe|vqxn|zzlU[_fus|||yt{}s}qpjruoxx{u~}~|vls}su}czoep{rza[kodpv}wgipov{zsqrzmbejp}do|_bysqtw~}|lokcZ`dl{wp{xvqouxp}uux~ltdqnvucXZS^cau|}wmw|omxx~val|ndxomkUZao{orflzrcwsuyinz~{rx|yrnkdmt|~keirrhx|zvullh^ew|zystuu{~powuwyvutnefkn}}t}|wqywg}gtxwxat|yuyutmkpomhp}zzu~~lvqtlous~~mio{ysftkpypmmz~~}{ytv{uwyxw|zus~xnb^nu}|uwrwztj}x|wrkprtzzorx{}tmt{yx|}jsumux}~r~wzpujnsdqpjdcmhiiow}wum\fop|nt|xnvztrykp~p|y|qlljkdido|qq}llvtrvsxklowzr}}spytvumnntrw||qck~lqzyztzrbp}vuq}~t|v{ninkfYg~qwuokmtv~}xsio|vtmq|zhntmrstvy|szve[ayqy}mnuu|sqqqtps}~y}ojo]dv~sqrv{snv~wossusxtm{{zuyvvumbdr}z{w{wmopv|{yovvwz}yxpyqgzqn~uf`dkrn~uqz||^isz|{yfglp~z{obn}mojypzx|{}rgms|y\m}uvn\[ptpvxqkouzsfhwvjfvrpn|vw~|z|{||rnryz|uw~{tblnut}tuwvq{{vwusytqsuollgisonuww|rns|~rou}}}svqfhzthddgoo{oe^gx{z}xqrfoy~{{vnqtyjoso}w~~jp|g[cgy}q|}~uyts|~|z{|}zuneijgnms~tu~}}}{q{|m}xr~~~{~|qhhu{z~rx~XLYkvu|{tmstpozxgcjouv~|nvw|yyqx{|}x~zldqzpqgkt}}y{|llxs}ywrvyu~xbftql}}xz||~xzzz{~wo[Ygbj~xsonfkkyzvz~sn{tu{vv{tqpnkyupw|rs|znlptz~~|usu|uq}yv{y~t`cknpvxuzqp||tyyz~rqjoxv}puunlvwq{smtytneertussx{mz|~}}{|p^hz}sit~}|mfhrywipnqu{z|zyuv{uqtwurr{zyyz{z{gim{}vuwxxvtry}||{uomowtxxvs|vw{wos~~~ztr}yz{{vv~{srtjcedjr{vsr{|}zmryxqt~~yw{vhou}~{uzslpmfpoahvomnhp{ww~rty{|py}xecrpto{yw|~~lhqnd_mwpmmytw}}}}}|mrz{utjq{lrxowzz~~{yvxv|uptmi]aqe_pw~{p{~{uy}ytvrmlouspr{ytiky{uknlw|{{ztjlyzxxyvsry~}x~womxxwqpy}wplionrz|}~sgaakwvwzzy{{||~~w{vrq}{y{~xvz|}}{spq}x}twx~mryyrw{xljtxyw|yw|}wnjoso{|xy||xw{w}vjlnq}x~smr|zrrtz}}}{plniehpsz}}{umt}}{~|{vmjms|~}nc_V[b`oy{~|{wvx~|~xjmxvotvhfenwr||sptxrwzxw{vz|~|z||usnpsr}unmrzpu||yzzzroimz{y}zw|zw{~wty}y~}rvwuqpt~{wyzvpw~ts|~xx}{|qyy|zu{zvrsuvrqx~{}zvv}}yxvtsqxwzvyz~wpx|t{x}{nvwxy{|~|uqsvvu}wtuuyy}~~}qkrrwzuwvu}wpt|{zoostuu|ztux||xpoz|xx~{}wryv~zuu~}wlrsxnuumoqqhlkpxzz|zofhpv{{|~~yy}vqxyz}rxvruuwvsjmqkx~}tw|opz}~}v{z|rprtuu{{{u~sqpuwxz}yomx~|svx||~wuvpmz~zu{{{z|w}qrqmlnswz}xvuprtrzz|v~|xw|z{xqqxzl}~{}{wvy{|ujdlvwwovrxxoxxrxru}w|~pmkmx|}|xyupux}~twwsrsrrx|{ur~yy{tpoln{vv}yvy|zvw|px~rxz{y}~zywuxpqvty|rhiowwt|x|}}}ynou}|~rlks}z{wnrq{~qprx{}{}nvtno|~llu~}~zwumcmytv{xr~{zu~sswotqvwpss{}x{}y~}}zvtsy}yxtu|}~lojquy|xrxyv{zwyzvz|yvtrqkdrxstv{}{omsuptuzyyuuqim|}unlktus}sjiqxvzy~{rmuw}zuqsvjrwoq~yw|ntwzpgpvx}|z}{w{tz{|||qlprsvx}}rw|}z|x{xyuvv{{|~~y{|}}tr{||{zq^cflx|{~xqnw|x{xpqp}~~wsqpxwx}y|y~y{{{z|{tvuqn~ulirv{}pluy}~}{vwxsgnwru}}uvzxz{}|~|}z{vnvwu||ttjjqkw|u}{~mqy}yux{vsvwqsyprwy|yrrtv{zw{}~}vttz~rs{}yw~{}qirrtv~}{{vw{{uyuoqsvwy~su}uwytnxusumwzwsqz|vuswzr~zxvt{nimss{|ypnut}wmvys{vt~{{wstqw~wxtt}~y|xspkozz}{x{~{vsyvwtopruwtwxuyy{{}~xqr}{uz}~y~{|}tqtkegjpw~vpnv|uwrwz{{~xwyz{~|wqq{~zz}y|ywqijvohnrsqou||~{}~vns{|}xvwhmwywy|y~~}}|vrtmmjorqrqz~xuzwrx}yv}|{yupy{orzwyw}}|}~|wywzzxzytqfdswgks|zwwu{y{}}xtqzvprwzytxyrsw}yu|~|{xyvos|{{xrp|{||yyuqpu|yx}}uw|x|t{}xtrqx{x~x{~~xmpmnx{|~zzy|{|zwt{sy{~{~|zvzz|zv}{xvvvxux~yns}wx|{v|}~~xszxz~}{|{vu|w|tptr{x|zz{~wst}wxz}{vwurqptz|xxz~y~~vx~}}v}~}yy{srpvxyopoktwwwy|zw}{{sx~~ylmxzrv~pjmrzxww{}tx}zz{w{||zuvzx~zyrpmlru~}tst|wtv}}{|vqnknz~{wtvtx~xvx}~~{vxxtrpt|{wz~zwr{}tqy}wyz{wpx}{x}x~ztwwzusw}|~}|xx}~xwtuusyyx}srxzzw{y|{~zotzz}}|xuw}|y{|vz}yz|ujorv}xwzv|}{wx~}|vuovvy~wx}xvw||xzxtxtvx{}{uxw|~}}u|vyzszyvtprorqy||zyqhlux}{uv~yttvw}|vvzz|||zzupnlmx}~{}}ss}pp{wywtw~~wut}|}yx~y|uqrrvwz|ppqx}rsz~z|unv||x{~v~~}zz}~|~quysplo{xyw|tytrw|||wsuxyyww|~oy~qtyy{z{|}xngnyu|zsqtvu{vtuwx~}upqptz~~vtrz}v{{}}vz{{wzyz|{~}|xx{~zv{wrnkly}~{y}tuyz{~yy{xu||{|wvxrvxwz}vlmmqyw}wzyzqsx~|wnqrz}{toosrx~pr|~}~{|~zns}z|~~vn{}~}|ztjmwyvvwtw}~{suwvsoxxurs}{ss|~}|z|~utwyz|x{~vmsuyy~y{yzuzzvy~wy{vusvroqorxuswxx{tsu~}ztty~wyunp|ypmlots|vnipz}}|y|{vtkrz}x{vpsvzpwyv|~yqt{pltt|zz~{~{~yz~z}zx{{~vpsqrvx{xx|{|}yzu}zu{z||~{ussz|xyecmvzy}}yqx{zwwu~|{xvopu}|~x}~||y{z||}}{~}}yzqkx{pqouy~{ww|y}wxz|}yjowwu}}~}xyx~}{{|ymntqy|xqmpo||y|z|qs{xz}}|}{||yzxus{}{yzypprvz~|~}vwv|xv~{{~}~wknrtv{xy}yy~y|y||wurt~yy~v|x{trxyxzv}}wqptuvvy}t}z{}}~|rjo|{wszvrrvz|sywvx|{~~{}xtxz}vts{~{yuy~~|rtv}|}|{{xwwz}}{}ywurryy{|yy~wvyvrw~|}uv~||~{{~zvvxrpssw}zuvv{z~}vzz~xtw|{}~~yptw|||wtusqzvnt}yxxuy{wy|~~{tz~~|w}}zlpvuxu}y{~rqssokuxxut{}uv|}~{ux{~|yysz~rx|}ry|{~|~|xzz}yw~wurmntlju{}~|t}{x||y}~}{x|zwuw{wtvz|wqsz~~|utrz|{zzuopz|x~}|{|yy~~{ywz~{~v|}~|wvvxw{~}|~vupsy|{|~}|~~~|~|{yz{{||z}|{xyz}}|xy}u{{w}{ux|{zz}~zwv}yy}{}~}{|~ywvyv{{~~~xuz{zzz}}wyxvtw{z~~~{xx}}~~~~~}}|uuzz~~vsrlrts}|~||z~z|}~~yvwyy|zvuuz}z|zx}~y|~{}~z~~~|~~|zzwyzyzxx{|x|~|~~|yxuz}}}|~||~}z|~}}}{z||zyy|~~|}~}{yy{x~~~x}|z~~}~y{z|{zy~~}||{~}|{z{y~{~~y~|~{y}~{{{w~|}~~}}zz{}{{{{|}~}~~~vx{y}~|{}}||{y}~|}wz{||||z}}}|xy|}}|}~|{z}{}}{{}wz|z}w}zxzzyvyxz|}~|wuw|{~|~}~|}}zy}}|~yz|~{~{{vzzv}}|z}{xz|{{}yzz|~{{}~}~y~xzz|}{}{xx}|y}|}~|{}xy}{}}}~~|zy{yywx{|~~y~yyz{{~~~}}}{{}}}}y{~~{w|~}~}||~{~~zutzz~yz|z~{y{z}y|{vywy~}|~{|~}z{|}y~{z{{{z~}zz|}}~yzxvy{|{{}~}|~~x~y~}~}}|~z{}w|}z~~~xvvy}{zz}~~zxz|~xwx{|~}yvzz}xz{}}|w|{yz~wx~~~{{wszy}~{y~~||x|{x~w}{z{z~~{~||}~~y{z~}~}z|}~}vzxy|}yz|}{|~|}}z}|{{xzvs}|zz|}{{xw|zy{|y|{{xuz~zywx|z{~xwv|}{~}}~|yv~}|z{z{{y|~u||y{uy{~z|{{}~~}}{z}x{~~~~yy{}}|vz~}{|}}{}z~|z~}~}}}}~|}~wuyvx||uy}{{y{yyz~}}~}~~}}~~~}~~}}}}{||u{|zw{|{yw|}~wy}}|{y}}wtz{~|xyy{}~~~~~~~~ywsuxx~}}|~|yvz}||~~z||}y||zz{~~~{xz{|{}z~}{zz~w|}{}~yw|{|}~~|}~~|z}yxyz{|}|w}~z|}yy~x}{y|}zz}{|{~}y}{{|z}vvzy|}xz|{zx{zz|~~|{x||x|z{~}~z{zxxz{~~|{z~z~~yzxx}~{{~{{}{~}|~~{y{~~~{~~z{|uwwx|~~yxx|}z}~x}}}~||~}zz{~}~~}~|||xvy~~wvz|z{y}~~}{w|~}~{|zvy}}}}}~zzywzuzz{zy~~{|~zz{~|~~{{z}w|}x}~}~}~}{||~{}}{zytt{{ux}~~{{{z~|~z~yz{z{}~{{}{zz~{z}{}yzz}~}|zz|~~||yy{}}}{z~~~}{z{|{{}}}|z{||~~}{z{~|~~|{z{~~~~~}~~~~~}z{~|~||}z~}{|~~~~~~~}|{|~}}|{}z~||}|{|z~~}~~}||z}~|{z~|{~}{}}}z{}~}y|SPLASH JON\`\\\`\X``\\`\\\\\`\`\``\``\`\`\\\\ \\\\\`\`X\\ ``՜`d(```+```((`````d`(`d``dddhdhddd`d]ddYd`(``$`$d```d`h̜̙gj̙dgdd0d`0-d-d`ddg`dddddjdddd̜dgdgdjddd4Zj`d`0d`g-0d0`gj˗iȑi8icfcl5i58`i5f58f8cf8lšfiȗifŗcifif58cf/i/>`cfcffffiih•kŒŕnnhfkfhfh;;hf;>c>h8hn8@kk؝˜’pChh>Fckc>`k6>>fch8ChhEmorjojCCj>jCeC>Ch@om>@hEhj@CIeTUDTFUEN@eSUSS6U4NJeREST6U4^KdS5STVd24ή8e56CM[eR4QEVU3D;ޒE&E܎[T65\cEE([cEE;YS6E#5FEDEeT4[OTTUNU`6=mEtL]MndcJۻ5&FDL EEԸmUdK=Ĭ[Ue[ UE5I˺ʑ*\TT93TEE,˜$C [DS2A#)̭E4˺,C:0!@QAjS`|{|tKwR@0,M#H'V?LjQr{|8sj@7:E#@+=.8]nUauyxLqHH36@C'@8PGJcmDu`K)PG14'0>RKd[Ty{w{@t{Z`K'@C@=8AOQ`m[n^jX)<[J+'1,PO@[Wf|z|~rQhQ8F?@@4,0KKGUf[fzagqxX0<1@DDIMVukavmlkmmYQJDCFIKTOLQZelqw{{~}yxtpoifb``^cbbgfffjmqvwyz}~||xxtunollgnljjnloqsswz|~{}z~~~{}usqnfbj_egciaeZcf\mltv~txgrsli`k_X^\bRie^[]u]i}~ptolkjlX]\^MQ`\S]aRYe`go|tqbtidqZY\cMJ_UdZX^S`cmixvj`qfjl`P]aJJcWYc`VXZdnkzvebskdfhSVaNKW`]`^V[a`jovli_haniX]ZRKXYV\ffW]dgbt}gfgejlgQ]bMGQbQ^iXZ\idox|nk_kgtaXaXVH\N^^gcU`cfiv{toWXZZk^`PcVPSM^Zlg`cgsi~xP263BMQX@HGLRhypahv|}@0G#\;h]0>AOMoe`M`|t}|zD15'LW_PNC8V`|v`Keotrb-(<#NYqO0FGZk{fTMjy{{xgrj,27!TZg6TF7_~fUMkvz~qeqD:'IDkgB6Fg_x`UZj|tqqmopH7C SO`[4HWp^M\qwxxn`rlb)@+,ixrcjy}T,YjD<+=VNBRotuyoityz}VLpqI:*!GG6>Qlgs~ijoyfQUiN:*2-BEAXdztnhep{y~XUjW>8) 4=CJKimwzdjiqwV@ilD7'7G-2_qyikox||~~jXp_J=( CC78X_u|jkoyw{xd\muP;(/IM@5IRvuyqo~~|z{xg_tfN<(3VD7ANQuwwtvzy~~[ly_D*8G<9DRU{lwu||~wWlw`F:8I?<;AG^qxoy|y}d^tL8*5L@9LNMepnr||Pdi@AJMG=5GXSfzjd~|bp|hTJBPCL12TSXi_k{~af|tYJHOAGBHEGYmecq|~dgeTIEMQ12IMVYVtspdm}q`JV]PLGGN\^iicu~qvyw~otsl^HMUR>6??GG\e`szw~x{j]fz_==Y[L@MHQTSZ`fx|tz~bemNLKHKKGKY_\`kjo|}sy~~|{w}suxoVPRYWCEP^d_gksv{yp}{yvypt`LSNQE828EJRV``m~~la[gtRIQQRYMNQOMU]iohns}sjkphd\ULPV]]fda_`lvy|~y}uy}~}}zwuoonpuuqqqnlro_gkdcltu~y~nnkickgokgawsssysrmlswsw}|}mtonlzm{wxr|tvznsojbokpstqqoflqmqux{~|~}}vvwwunomhkmpkrspihsqkqnqq~||}xvttjgfWPLVUWXaWVcjrr~yzlebkhgl__dm`]d`b^]a_]elpr~}|xxy|}}xfnfkjiX_f\Wdhgnngghjrt{|y~}{pmwzrpti`gc\ajjmojjnrstx~{snrrwvkkme[cfb\ZbYZViaqv~~xmlbadbTY_WOW]admfeegghpy~uuv{yyqmdkotohe_ZPWY_ekmbenqu~}rl```ammhbliec_ehmomppxymQJKOX`g[X]]`nzxnggqux~cMREYWegG=GMO`{~tc]fuu}v~yX@C=O]]]YVJZcuzw|m[dsu}tL:C9L]jaLPUaozh]k|vvxSILBVemWZ\Qb|uc]juvpvpgi}jUFP9Gfq\JJZ]wka]kw{uqoom{cH6E@QX`cPQ\k}l[apx||vovv~tLH?;EXh\]W]hx|jglqy{wqsqwoPHL7K]ec`a\rpgediommmmt}dJ;>:K\hiQM]u}hX`nqqtuqpo{~UJ=5CXhgl`Zfx|pdclpnszxuy[OC9I\_jghx{~tka__gr~\SE<8CXdglaq|snd[\`s}yRHA9;FY`nplu~|sb`a]nyZUWB>K^^bjrv|yzwrjdgufUMD>DPZ\fkpzzmqjhgr{yWTK<>>PZ[egw~uxlehbm~~WOMA:>PUY`gs{~ylifftaWT@8KNHUcYau|hhnou|tSZGPN`^Xgn]h~{||qoxz}`h[QP``[fp`jsvtryxv~|dpYOOPIwjRqnv~h}ozyzzxyoqdaNON\Qfjbvlow|nj{}~nwd[V^fZXblfewz}}yld_[h\]ickkiwt}yxmbYidVkh]fnjrx~v}q``nbailafhjj{uyzn``feglnelljkpzupk^\cebeihhjektv||rhecgkookichke]hu~xuz}vy|n`]a`eiqrwtqvzzfzur|pj{~kgekqknyyunnstow}uZ[fRAGF]i`Rbumjnt~xmfgplpyy~~zr{~odxpny}wy{pa^ejZ`pstuww~~tlkiTJ]\DDYejyoq~z|~xlpq`axtqz|v\Z}srohntsxtjbcbcprlwyy~|j{|pm\rnRNW]ghljxuxt~{smhfopos~pYkwkodrzpxz}~maelhfrqo{v~luprnlsfTOgifhphu}q~vzx}}|ulhlijvs{ueks~tjdtvvv~{}}rkckimlqrw||~ut}|vlnjhh\QXfinjpvy|zxx{uuqjnuvq}|~hds}lpndt}so}}|zusnmmurpyvxxntzllb`te^belwwnt|yvk}zy~|{{zxxv|||lou{ikbkctpp}|{yzv}x~|~}}{{}{qv{nhj`bjgkmlz~uu~zuyu{{xgg|qdf\^jl^g|{u}z|~zutxoh``thijzq{~{twy}v}z~tpy}gg^jno`kisy~~||z~{}}}}~tuqlh`msdijprxwzzz{}}~xo}oj^dkjjfpqt|uzz}|{{~~rq}}oifjnjglkh{zv~|}~|~zsyzde]mrionhlyuy~~~xj}nkjppndfprr|tx}|{}~}pstliqhp^hrtusp{}}~}{~l}xniloejimjhuzqv{}|~}{kv~nnhmpq^hrnxpu|}~|{v{xvvzwzy}{u~yr~x{urv~{|}~hagotqxu||rszxpxsnHWPPKdfkkuiyzy{{~}`^en``jmc\Tiv{pxgfrjsq{~mipdhhjfofmswywn|pdfafru{|z{l^g]eegljs_wxq|xy{wtuztZl_cbh\t|ptw~u|~yvrvxkTYIDLOW^j^ozxyxyx`l`bdb_^taarzt{pnialqhwvnkyz^qb`arizvsvxmqyiurlamv~{r}gr]dXp_xswkxxvt|z~p~~}yzWcdUP`nkxix|tzuv}s~`a_\Tectnga~{njw|ns{zq}_g\aYp[wpsf~vnrmytri{~yflghbslwuxj~xrq}szzy}|~{wj[ee\hnrzwsw{}~w}~}|yY]UXVe_kd_l{|{wtwzxw~ldlc]fikpohpv{}wtkilntept}rujkiehjsyst~rtjrmwhnuvqsy}pnmllzmxxq|uovqz~uyzzmhjhgspu|vvt{xw|~xfWdbbQsgug|wyy}z{yg_bc^bejeldzv{zzwopiltzw~ffgkbvwuutot~{tnhc`mltxxuvgspqlwyzx~~{vpmnsprzy|}yx}}gp{yi{x~v||xz}}}|rvps}x}{n^imjo{v|vu|xt{zrvn}sxgP_\^_u{|mvyvwtxqsx|irrn_fghqfrpwkpqrvsq~}tq{}zpq{{{|wta`abonxunrw}yyymrwq~}y}|}uuvp{~~r}zxxywypgpqnix}~~~}woziq|ma]botxxvkux}vvunp{xlzh`aohmmtumpqxtyxzrsy~zx~~xfd`citzq~uxz~|}w}z||~~~zttrmz{{}|zu|wtlmqrsutuzx~|pidfcjozs^jquyy~nxy{w|~vxuztz~zdkbhpxywvlqz}{|{||~||~|t~}oohnt|zus~pqqry||qswutlnhfflyv|loz}wyzsswzsp}}~~}~}oiljbkkvy{zy~}{}{x|~~ylqjipuvw{vv~{ywuuvx{z~}~~vnjphnptsuzu|~~yvwxvw}~ylpmhkovt{vy}}{xtuuy|nriignuwxzs}zzustv~zlnihinuu|zy~~ztvut}yprrhkpwswy|}}~~|{wvx~sqnkimqttyy{{y|wxw}znslhkisstxw{|xvyt||mqnihkrqtvx}|xxww~psphhqnmtwqx~{}tzzz}psrhgpoltwot~~~yx|}ptnhhppnsxpuz{zy}|{~rxmhhknlruvuxyxz~~zyqpgjgmopnx{tx}xzrmkpqmnpurs{}~}xqnpsopttrvxy{{}wpntqlttpqxuy~|~wqpvqqtvptutv}|}|vqpsrsuwsuutvy{|{vqqtstvvvvvuwz|~|wrqpqtvwvyxtvzy|~wpoppsuwwyxvwxw}~~uolpqrtyyxywwxyy~yspolsstx|xx{wv{|{}vronqpsw{x{{zy{z}}xroprorx}xz|{y||}yusrnrssu}yy}~y|}~xqstmnxvu||v~~y}|~xrpsqpuvu{{y}||~}xusqpsruw{u|~{|~}~yusqpsstwzy{||~}{}wqquppwwuz}w}|}~||vptsprxtv}yw~{|{xsqsrqvvwz{x~}~|xvqsqssvvx{z{{|zsqusstvxyz||}{xyvrtwvsyywx|{|~zzwuswvuywx|{y}~~{zxvvwuxzxx~|z~~}|zxxvwwxz{}~~~}|{zyzzx{}|}~~|}}{|}|{z~~~~~||}}}~~}~~~~}~~}~}~~~}~~~~~~~}~~~~~|}~|}~}~}}~~}}~|~~~~~~~~}~~~|}}~~}~~~~}~|}}}}x}}pqmvytxvru{y~z~~~~~|t~vutxxwqrxxy~z|~~}}{}}~wx{vswtwnsx{zww|}}}~}|~u~{vsuvqssutry|wz||{}|{sy}vvsvxxnsyw}wz~~|{xzxwwzwyx{z~{}{}z|}~milputzv{{uv~}}}y~yv\e``[nnqrwnz{yz{~{~ffjpfiqrigdr{yroxsxw}~qn~~sjllmjqkosvyyu~woplpy|~oekdkjkpouf~vxr~~}}|}wcpfhgmeuzrv~x~v|~yw~z}~tbf\X]^cirht|yyy~~yy~~gofgjjhhwily{yvrltwpyztpzzerhfftlywtwyru{oxxtku|xktdjasfyuxoyyxv|{~s~|}bkl`\hspzny|vzvw|u~hhge_ljxsni}spy~sv|{t}gmehbtcytvl~xrvr{xvp}|koklgtowvyn~yut}u{{z}~{qdkkelruzwt}~wz{}w|}||dgbebmirmis}~|xvxzxw|pjpifmpputov{}|yrpsuynvy~wvnomjmouzuv~wypwrzpuyzwy|rpoooypyys|wrx~t{~z}~pmnmktr~u{wwv{y}{|oclkl^wnym|y~xx{y~~}|nhkkhlmqntn}{~}~{uuprw{x~llloiwxwwxty}ytplksty||zwktrspwyz~y}~{xtrsxvx~|}|~{krywmzx}w|~{xz{~||z}yy~thoqor{w|xv~|yuzz|xz{oakiijx{}sz}zy~wxtvy~{lttsjqqswoww|sxwwxvt}~yw}~zssyyyz~}xymmlovu{zwy|}}xotxs||y}}{{|||}z~z~{}|{tmttsp{}~|||}|}xvx~umikuvy}zzry{~yyxsu{~wpzqlnvtttyyvww{vyy{wy|~~zx|{}~|romory}x{|}~zzz}||}~}|~||zx~~z}zyssuvwxxx|z}}|~xsqqosu}xkrvwzx~u}}}z~y{x|~|}v{}|psotx}|{ztw}}~|~{~||}|~u}}wvsx}}zx~vvww{~}uvzwwuvtrru|{}su}}yz{wx{}xv}}~~}~|ususottz{}}|~~~}}~~~|{uxutx{|{}z{~||zzy{{||~}~~{wtxtwwyxz}y}}|{{|zz}~~|vxvtuw{z}{|~~}|zzz|~wyttswz{|}y~}}zyz{}vwtttwzz~}|}z{zz~|xyytux{y{|~~~~}{{|yxwutvxzz||}}|~{|{~}wyvtutyyz|{}~|{|z~~vxwttuyxz{|~~||{{xyxttxwvz{x|}~z}}}~xyytsxwvz{wz||~~xzwttxxwy|xz}}}|~~}y|vttuwvyz{z|||}}|xxsusvwxw|}z|~|}yvuxxvwxzyy}~~|xwxywxzzy{||}}~{xwzxvzzxx|z|~{xx{xxz{xzzz{~~~~{xxyyyz{yzzz{|}~}{xxzyz{{{{{z{}~~{yxxxz{{{||z{}|~{xwxxyz{{||{{|{~zwvxxyz||||{{||||yxwvyyz|~||}{{}~}~{ywwxxy{}|}}}|}}~~|ywxywy|~|}~}|~~~|zyywyyyz~||~|~~|xyzvw|{z~~{|~~|yxyxxz{z}}|~~~~|zyxxyyz{}z~}~~|zyxxyyz{}|}~~~}~{xxzxx{{z}~{~~~~~{xzyxy|z{~|{}~}|yxyyx{{{}}|~~|{xyxyy{{|}}}}~}yxzyyz{||}~~~}||{yz{{y||{|~}~}}{zy{{z|{|~}|~}}|{{{z|}||~}~~}||{{{|}}~~~}}|}}|}~~~~~~}~~~}}~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}~~~~~~~~~~}}|||}|||}}~~~yyyy{|~|}}|}~xzxxv|{|}}z~~}}~}~vwxyvy||xyz~|~{z~{xxxxwzxyz{}~~~~}}|}yvxvyxxzz|w~~{|z~}vzwwvyw{|z|~}|~}|~xzxvwwxz}y}}}}~~}}~~wyvvxyyy}y|~|~|~}{~}vzwvv{x||{|}|}{~~{x{vxu{w}|}z}}}|~~{wzzvtx|{~z}~|}||~|xxxwuzy~|{y|{~|}~|xzwxv|v~|}y}{}|~}|xyxxv{y||}y}|||~~~TTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTTc A0PpppuwW'w>!?8??>?  @ ?6 6 T*Ё` (>?Ƞ$`"A 0% (F.9n˾/H$O0( 3 6 8 1< * /0#l 8? ?~0#B." x ?>6 TP`(Ƞ$ ($H l?~0#B." x ?>6 TP`(Ƞ$ ($H l?~0#B.8;?{p8|pp8|pp. UONI.. EONALERT BAS hNJDATE BAS hN{TIME BAS hN} README TXT kN}LionpoulosJJ f3 * >> Sub-Routine to draw an Alert BoxB >> For use in TIDS Version 2.04 (The Ictari Diskzine Shell) ( >> Coded by Steven Jordan02 >> Copyright Diamond Software 1993-1994<F6Pͦ:::ަ:::BMAX <Z::():A(()),d,@,(nB0X$():MOUSxtNUM_BOX:B0X$() Retry:B0X$() Cancel:B0X$() HelpTTITL$ DISK ERROR:TITL_WID:TXT$File not found.XTXT$TXT$8 Please insert the |correct disk or select another file.`X:Y:W(:H9:ICON:@:EXIT:NȊ ----------------------------------------------------------------------NҊ | Draw an alert box with title bar,icon,text,OK boxes |N܊ |--------------------------------------------------------------------|N | Entry - X,Y,W,H,ICON,TITL$,TITL_WID,TXT$,NUM_BOX,B0X$(array) |N | Exit - EXIT = -1=error or no boxes / 1=box 1 / 2=box 2 / 3=box 3 |N | Exit - X_BOX,Y_B0X,H_B0X,W_B0X (alert coords), Old zones deleted |N | |N | If x or y = -1 then the window is centred |N | The x coordinateds are put on a multiple of 16 |N" | If ICON = 0 then no icon is drawn and the title box is full size |N, ----------------------------------------------------------------------6V@WW: - Make multiple of 16xJXX@W:XXXX: - Centre on x or -"-xTYYH:YYYY: - Centre on y or -"-|^X1X:Y1Y:X2XW:Y2YH: - Get Co-ordinatesphOX:OY:ICONOX2OX2: - Get offsetsLrSCR: - Screen for textt|X_BOXX1:Y_BOXY1:H_B0XH:W_BOXW: - Save for redrawing? Draw main alert boxH:X1,Y1X2,Y2X:X1,Y1X2,Y1:X2,Y1X2,Y2X:X1,Y1X1,Y2:X1,Y2X2,Y2Š̊ Draw the title֠X1OX,Y1OYX2OX2,Y1OY:X1OX,Y1OYX2OX2,Y1OYPX2OX2,Y1OYX2OX2,Y1OY hX2OX2,Y1OYX2OX2,Y1OY LX1OX,Y1OYX1OX,Y1OY dX1OX,Y1OYX1OX,Y1OY ZX1OX,Y1OY X2OX2,Y1OY l&X1OX,Y1OY X2OX2,Y1OY 0: Draw the boxesDxNNUM_BOXBXX1:BYY2:WBMAX:H :XNUM_BOXBXX1BMAX:BYY2:WBMAX:H :bNUM_BOXBXX1BMAX:BYY2:WBMAX:H :lvNUM_BOXXX1:YY2 :T:T$B0X$():~NUM_BOXXX1BMAX:YY2 :T:T$B0X$():~NUM_BOXXX1BMAX:YY2 :T:T$B0X$():~ Draw the iconnICONSCR,( ),ICON,X2OX2,Y1,^XX1:YY1:T$TXT$:T:~hXX1:YY1:T$TITL$:TTITL_WID:~Њ<ڊ Setup the zones - 1-3=Input boxes / 4=Icon / 5=TitleP,X1,Y2X1BMAX,Y2f,X1BMAX,Y2X1BMAX,Y2f ,X1BMAX,Y2X1BMAX,Y2N,X2OX ,Y1X2,Y1L ,X1OX,Y1X2OX2,Y1<*,X1,Y1,X2,Y2,,X1,Y14(> Wait until the user selects a boxHVREXIT:MOUS::NUM_BOXEXIT \,f:Z():M:H Np:ZMNUM_BOXEXITNz:ZMNUM_BOXEXITN:ZMNUM_BOXEXIT\:H;HHrNUM_BOXEXIT@:H<NUM_BOXEXIT@:H=NUM_BOXEXIT ::EXITʊLԊ --------------------------------------------------------------------Lފ | Draw a box |L | Entry - bx,by,w,h |L --------------------------------------------------------------------x:BX,BYBXW,BY:BXW,BYBXW,BYHz:BX,BYBX,BYH:BX,BYHBXW,BYH:BX,BYBXW,BY:BXW,BYBXW,BYH$:BX,BYBX,BYH:BX,BYHBXW,BYH.8LB --------------------------------------------------------------------LL | Draw The Text Routine (Text In T$ & Needs Starting X,Y) |LV | Entry - T$ (text), X, Y, T (width), SCR (screen) |L` | Use a '|' in the text to go down a line (6 pixels) |Lj --------------------------------------------------------------------tl~L(T$):POS:T$T$():T$(T$): if L>17 then L=17(OLDXX:OLDYY"POSLHTX$(T$,POS,):TXT(TX$) ,TXTTXTPTXT\XOLDX:YY:<SCR,(),TXT,X,Y,LĢTXXXX΂POS؋  *    d  @     f  B    PALTD"3!w````pppxxx|||xxxXXX|<??@@@```pppxxx|||~~~ppp```@@@@??????@x   x@A>>?>AA"U""UAA@">?AA"U""UAA@>?A>A"U""UAA@A>?>A>I"U""UAA@>?A>]*U""UAA@">?A]*U""UAA@>>?A]*U"*U]A@>*?AA*U"*U]A@>6#AA"U"*U]A@>AA"U"*UIA,@?>AA"U"*UIA>@?>AA"U""U]A>@?>AA"U""UAA>@?>>AA"U""UAA@?>>?AA"U""UAA@>>?AA"U""UAA@&%%%&&&H&H(ROUTINESTLx@l4 ` ( $XPAL&OLDINK&CURINKSPRMAXNBVERSION$n8H <D"3!wr  | * 4>HR!"$\& ')f+,.p013z5(68:2;=?<@BDFEGIPJLNZPQSdUVXnZ[]x_&`bd0x<x<@@@@@@@@@@@@@@@@@@@@@@@@@@x<__ __ x<__@@@__@@@__   __@@@__@@@__   x<```??@@@````  ```??@@@````  x<__`@@@@@@@??@@@__   __`@@@@@@@??@@@__   x<@@@__@@@__//PPP  @@@__@@@__//PPP  x<` `@@@` `@@@x<` @@@@@@@@@@@@` ` @@@@@@@@@@@@` x  )v l݀"AAA݀" 8         8"AAA"       8  8 l>go> 8  p    8>go>       8p8 d̀@~~             @~ހ~ހހހހ                 d̀@xxxxx    w           AA  p@xxxxx  w             耀p耀耀耀AA d̀@xVPPxJHHxzxxx x x x x x             h(@xxxxxxxxxVPPJHHzxx                  h( d̀@}~@@~}{~>      >>  }} yy ::   hhh@}~}{~~@@ހրހ>             >>hh}}hyy:: d̀@~~~~             @~~~~ހހހހ                 ~~Lionpoulos`` * >> Sub-Routine To Work Out The DateB >> For use in TIDS Version 2.04 (The Ictari Diskzine Shell) ( >> Coded by Steven Jordan02 >> Copyright Diamond Software 1993-1994< Fͦ:::ަ::"P 14/10/1994:D$bZ:DAY;TH$; ;MONTH$;YEAR::Error :;EXITdnNx ---------------------------------------------------------------------N | Work Out The Date Routine |N |-------------------------------------------------------------------|N | Entry - D$ = Date DDMMYYYY |N | Exit - DAY, MONTH, YEAR, MONTH$ AND TH$ |N | - EXIT = 0 if OK else -1 if error |N ---------------------------------------------------------------------tDAY((D$,,)):MONTH((D$,,)):YEAR((D$,,))dҢDAYDAYMONTHMONTH EXIT:Fܜ,:IMONTH:MONTH$:ITH$thHDDDTH$st:DDTH$nd:DDTH$rdEXIT"f,January,February,March,April,May,June,July,AugustB6 September,October,November,DecemberLionpoulos  * >> Sub-Routine To Work Out The TimeB >> For use in TIDS Version 2.04 (The Ictari Diskzine Shell) ( >> Coded by Steven Jordan02 >> Copyright Diamond Software 1993-1994< Fͦ:::ަ::"P13:03:23:TIM$Z36XdT_MINUTET_MINUTE; ;T_PART$;HOUR; - ;BnT_MINUTET_PART$;HOUR; - ;LxT_MINUTEHOUR; ;T_PART$; - ;PART$N ---------------------------------------------------------------------N | Work Out The Time Routine |N |-------------------------------------------------------------------|N | Entry - TIM$ = Time HH:MM:SS |NȊ | Exit - HOUR, T_MINUTE, SECOND, PART$ (am or pm), T_PAST$ |NҊ | - EXIT = 0 if OK else -1 if error |N܊ |-------------------------------------------------------------------|N | Display Routine Explination |N |-------------------------------------------------------------------|N | If T_MINUTE > 0 then display = T_MINUTE," ",T_PART$,HOUR |N | If T_MINUTE = 0 then display = T_PART$,HOUR |N | If T_MINUTE = -1 then display = HOUR," ",T_PART$ |N | |N" ---------------------------------------------------------------------,V6HOUR((TIM$,,)):T_MINUTE((TIM$,,)).@SECOND((TIM$,,))`JPART$am:HOUR PART$pm:HOURHOUR $TT_PART$ Minute PastR^T_MINUTET_PART$O'Clock:T_MINUTE@hT_MINUTET_PART$ Minutes PastRrT_MINUTET_PART$ Half Past:T_MINUTET|T_MINUTET_PART$ Quarter Past:T_MINUTET_MINUTE-T_PART$ Quarter To:T_MINUTE:HOUR:HOUR HOUR:PART$pmPART$amPART$pm,HOURHOUR  THE ICTARI DISKZINE SHELL VERSION 2.4 SUB-ROUTINES By Steven Jordan - Copyright (c) Diamond Software 1993-94 I have decided to give away some of my old sub-routines from a program that I wrote last year - TIDS V2.4. You may use these source codes for you own program, but you must put my name in the credit list! I have more sub-routines from TIDS Version 2.4 which inlude new file selectors, fast text viewer (with-out gfx (that's version 2.6!)), data and text file loaders, shell source and a few other routines. Steven Jordan Diamond Software #a000000 #b000000 #c7770007000600070055200505552220770557075055507703111103 #d #E 18 12 #W 00 00 02 07 4B 10 08 A:\*.*@ #W 00 00 02 0B 4C 09 00 @ #W 00 00 0A 0F 34 09 00 @ #W 00 00 0E 01 34 09 00 @ #M 03 00 00 FF A ICTARI_MAG@ @ #M 00 01 00 FF B FLOPPY DISK@ @ #T 00 03 02 FF TRASH@ @ #F FF 04 @ *.*@ #D FF 01 @ *.*@ #G 03 FF *.APP@ @ #G 03 FF *.PRG@ @ #P 03 FF *.TTP@ @ #F 03 04 *.TOS@ @  ICTARI USER GROUP ISSUE 19 February 1995 ___ ______ ___ _________ _________ ___ \__\ \ __\ \ \__ \______ \ \ _____\ \__\ ___ \ \ \ __\ _____\ \ \ \ ___ \ \ \ \ \ \ \ ____ \ \ \ \ \ \ \ \ \_____ \ \____ \ \__\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \__\ \_______\ \______\ \________\ \__\ \__\ * m a g a z i n e * =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= I C T A R I U S E R G R O U P 63 Woolsbridge Road, Ringwood, Hants, BH24 2LX Tel. 0425-474415 =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-= INDEX FOR ISSUE 19 ================== ASSEMBLY Various Falcon specific assembler routines. Joystick reading routines. 'Thermometer' progress display code. C GEM Tutorial by J White. Part 9. Text packing using Huffman coding. GFA AutoZest (GFA Interface Creation Utility) GFA Programming Tricks and Tips. STOS Mad Bomber game code. Routines to draw Alert boxes and work out time/date. PASCAL More small programs. MISC Desktop .INF file information. More information on GIF image format. Current membership list. In next months issue of ICTARI (this may change) :- ASSEMBLY Using Calamus fonts in user programs. Screen raster routines. Making CPX accessory files. C GEM Tutorial by J White. Part 10. Questions and Answers file. GFA Football game. BASIC Disabling some menu items from Basic. STOS STOS fix code for different TOS versions. PASCAL Miscellaneous example programs. MISC GIF/TIFF file information. For future issues :- Polyline drawing routines in machine code. Bezier curve drawing routines. Picture compression routine for IMG pictures. HP DeskJet/LaserJet compression routines (Mode 2 TIFF). Picture switching techniques. Printer driver code for printing mono/colour images. Sorting algorithms. Using the BitBlit routines. Code for using the File Selector. Overscan techniques. STOS sprites. ---------------------------------------------------------------------- EDITORIAL ========= ARTICLE FORMATS --------------- As we have had quite a few more members in recent months I thought I would just mention again for their benefit that if you send in a text file for publication it would help me if it was in Protext format since that is the WP I use to compile these disks. If this is not possible then a standard ASCII file will be quite OK. CORRECTIONS ----------- The GEM Macro information file (ICTARI 18) should be amended as shown below. The 'rsrc_obfix' function in the AES Resource Library section is incorrect, the ENTRY parameter 'object' should read as follows : - object = The number of the object to be converted Thanks to John Logan for that. Also in the VDI Attribute Functions section, the vsl_udsty heading should read :- Set user defined line style. but I'm sure you had already worked that one out. TELEPHONE NUMBERS ----------------- As you all know everyones telephone number changes on April 16th. Most codes just have a 1 inserted after the initial 0 although some codes will change completely. I will update the membership list next month but if your number is one that changes radically, perhaps you could let me know. ---------------------------------------------------------------------- CORRESPONDENCE ============== To: Peter Hibbs From: Keith Baines Disabling menu entries when an accessory is opened. I don't know how the HiSoft editors handle this; they have other non-standard features like sub-menus as well. However, there is a fairly straightforward way of checking whether a program's window is on top, which is as follows: - include a short (e.g. 10 millisecs) timer event in the evnt_multi call. - whenever this is called, use wind_get sub-function 10 to get the handle of the current top window, compare this with the program's own window handle(s) and adjust the menu as necessary. I've included a short example program (MENUDEMO.BAS). This is written in HiSoft Basic, but uses the AES window functions rather than the built-in Basic window system, so should be easily translated into other languages. There are two extra tricks: - we can ignore timer events which happen in the same evnt_multi call as another event. - the program uses a flag to keep track of whether it thinks its window is on top; this cuts down the processing done for the timer event. */ Thanks for the info, more on this subject next month. ICTARI /* ---------------------------------------------------------------------- To: Dick Teuber From: Keith Baines Embedded Resource Files In assembler, the obvious way to embed a resource file in a program is simply to include it as a binary (the INCBIN directive in Devpac 3). The problem with this is that it needs some quite tricky code to find and fix up all the pointers (which start off as offsets from the start of the file). An easier way is to convert the RSC file into assembler source code (mainly lots of DC.W statements) and let the assembler deal with the addresses. This also produces shorter code. The only other fixup needed is to convert object co-ordinates from the character/offset format in which they are stored in the RSC file into screen positions for the current resolution. GEM provides the AES function rsrc_obfix for this purpose; it has to be called once for each object in the resource file. I've included a simple example program to show how a conventional program with an external resource file can be converted to use an embedded resource. demo1.s is the conventional program with an external resource demo2.s includes its resource data as assembler source I wrote a utility to convert RSC files into assembler a while ago and have included a copy with its (HiSoft Basic) source. */ Thanks, we will be publishing this code later. ICTARI /* ---------------------------------------------------------------------- To: Dick Teuber From: J I Logan INCORPORATION OF *.RSC FILES INTO *.PRG FILES OUTLINE 1. Insert the RSC file into the programme source file. 2. At run-time, convert pointers in the RSC file (which are offsets relative to the beginning of the RSC file) to absolute memory addresses. 3. At run-time, convert object heights and widths from the RSC dimensions of character heights and widths to screen pixels. DETAILS INSERTING THE RSC FILE. You cannot simply import a large hex file into a source file. It must be formatted in some way e.g. using dc.w statements in assembler or defining it as an array. Examples: label dc.w $0000,$0042,$0042,$0042, etc (assembler) rsc[0]:=0; rsc[1]:=66; rsc[2]:=66; rsc[3]:=66; etc. (Modula-2) Clearly it would be very laborious to construct these statements by hand. Chris Greening has written CONVERT.PRG (available on Ictari disk 18) which converts any file into dc.w statements. C programmers will have to determine the format best suited to that language. ADJUSTING THE POINTERS. I do not intend to explain the working of a RSC file in detail but the RSC file has four consecutive components. The first is the header consisting of the first 18 words (numbered 0 to 17). The second is the data area containing secondary and tertiary structures (tedinfos, bltblks, strings, graphic data etc). The third is the object list and the last is the tree list. The data area, object list and tree list are not of fixed size. Each file contains at least one tree and each tree contains at least one primary structure called an object. There are thirteen different types of object. Each object is 12 words long (numbered 0 to 11). The type number is found in the low byte of word 3 (ie byte 7). In most objects, longword 3 (ie words 6 and 7) points to a secondary structure in the data area of the RSC file. This secondary structure may be self contained or may itself contain pointers to tertiary structures. The remaining objects are self contained and object words 6 and 7 do not contain a pointer but rather information such as colour etc. The object types are discussed below. Object types 20 (g_box), 25 (g_ibox) and 27 (g_boxchar) are self contained and do not point to any other structure. No changes are required. Object types 26 (g_button), 28 (g_string) and 32 (g_title) point to a self contained secondary structure (their text string). The object pointer must be converted to an absolute address. Object types 21 (g_text), 22 (g_boxtext), 29 (g_ftext) and 30 (g_fboxtext) point to a tedinfo structure. The first three longwords in the tedinfo structure point to tertiary structures (text, template and validation strings). The object pointer and the three tedinfo pointers must be converted to absolute addresses. Object type 23 (g_image) points to a bitblk structure. The first longword in the bitblk structure points to a tertiary structure (bit image). The object pointer and the bitblk pointer must be converted to absolute addresses. Object type 31 (g_icon) points to an iconblk structure. The first three longwords in the iconblk structure point to tertiary structures (icon mask, icon data and text). The object pointer and the three iconblk pointers must be converted to absolute addresses. Object type 24 (g_progdef) points to an applblk structure. The two longwords in the applblk structure point to tertiary structures (programme code and parmblk). The parmblk has two longword pointers. The object pointer, the two applblk pointers and presumably the two parmblk pointers must be converted to absolute addresses. Each of the above pointers contains an offset or displacement IN BYTES from the beginning of the RSC file. It is a simple matter to determine the absolute address of the beginning of the RSC file after it has been loaded at run-time. The addition of the absolute address of the beginning of the RSC file to the offset from the beginning of the RSC file converts the pointers to absolute addresses. Because the absolute address is only known at run-time, the programme must contain code to adjust the pointers. Since all the objects are grouped together, it is easy to start at the beginning of the object list and process each object in turn until the last object has been dealt with. I have listed below the outlines of a suitable procedure (FixObject). NOTE the pointers in the header should not be converted to absolute values. How do we know where the object list starts and how many objects there are? The header tells us. Word 1 of the RSC file header contains the offset IN BYTES from the start of the RSC file to the start of the object list. Word 10 of the RSC file header tells us the number of objects in the list. The table gives the function of each header word as far as I have been able to work them out. word 0 uncertain word 1 offset of start of object list IN BYTES word 2 offset of start of tedinfo list IN BYTES word 3 offset of start of iconblk list IN BYTES word 4 offset of start of bitblk list IN BYTES word 5 uncertain word 6 uncertain word 7 uncertain word 8 uncertain word 9 offset of start of tree list IN BYTES word 10 number of objects word 11 number of trees word 12 number of tedinfos word 13 number of iconblks word 14 number of bitblks word 15 uncertain word 16 uncertain word 17 size of RSC file IN BYTES The tree list also needs some attention. It is simply a list of longwords, one for each tree. Each longword points to the first object in its respective tree. Each longword in the tree list must be adjusted by adding the RSC_start_address to it. The offset of the start of the tree list IN BYTES is in RSC header word 9 and the number of trees is in RSC header word 11. Compute!'s Technical Reference Guide volume 2 (AES) page 136, mentions that when a non-incorporated RSC file is loaded using the rsc_load call, the operating system adjusts the tree list pointers and then stores the absolute address of the beginning of the tree list in the ap_ptree field of the application's global data array. It would seem sensible for us to do the same. ADJUSTING OBJECT DIMENSIONS. The reason RSC file object dimensions are given in character heights and widths is that the one RSC file can be converted to work with different ST/TT resolutions at run-time. This saves writing different versions of the RSC file for each screen resolution. Object sizes are converted by calling the operating system using rsc_obfix. The call requires the programmer to pass both the address of the tree (ie the absolute address of the first object in the tree) and the number of the object. If we were to call rsc_obfix, tree by tree and object by object, we run into a minor problem of knowing when we get to the end of each tree. It is not possible to determine this by direct inspection of the RSC header. The last_object in the tree hierarchy should have bit 5 of word 4 set and it should also have its first word (the ob_next field) set to 0. This last_object may not be the last physical object in the tree object list. It would be possible to determine the length of the tree in bytes and divide the size by 24 to get the number of objects in the tree. Fortunately I think it is likely that rsc_obfix only uses the object number to index forward into the object list from the tree start address and does not concern itself with the actual object numbers. If this is so then the whole object list can be treated as one tree. This would allow us to process pointers and sizes in the same procedure and simplifies our task. PSEUDOCODE Procedure FixObject; RSC_start_address := absolute RSC start address (bytes); Object_list_address := absolute object list start address (bytes); Object_address := Object_list_address (bytes); Number_of_objects := RSC file header word 10; Object_size := 24 (bytes); FOR N = 0 TO (Number_of_objects-1) DO Object_address := Object_address + (N * Object_size) Object_byte_7 := value of byte at (Object_address + 7) IF Object_byte_7 = 20 or 25 or 27 THEN no action required; END IF; IF Object_byte_7 = 26 or 28 or 32 THEN add RSC_start_address to object_longword_3; END IF; IF Object_byte_7 = 21 or 22 or 29 or 30 THEN add RSC_start_address to object_longword_3; use object_longword_3 to access tedinfo; add RSC_start_address to tedinfo_longword_0; add RSC_start_address to tedinfo_longword_1; add RSC_start_address to tedinfo_longword_2; END IF; IF Object_byte_7 = 23 THEN add RSC_start_address to object_longword_3; use object_longword_3 to access bitblk; add RSC_start_address to bitblk_longword_0; END IF; IF Object_byte_7 = 31 THEN add RSC_start_address to object_longword_3; use object_longword_3 to access iconblk; add RSC_start_address to iconblk_longword_0; add RSC_start_address to iconblk_longword_1; add RSC_start_address to iconblk_longword_2; END IF; IF Object_byte_7 = 24 THEN add RSC_start_address to object_longword_3; use object_longword_3 to access applblk; add RSC_start_address to applblk_longword_0; add RSC_start_address to applblk_longword_1; (may need to adjust the pointers in parmblk also); END IF; rsc_obfix (Object_list_address,N); END DO; END FixObject; NOTE Object types 23 and 31 contain height and width data in their secondary structures (bitblk and iconblk). If their appearance is abnormal on the screen, try excluding them from rsc_obfix. GENERAL COMMENT. I dabbled with this subject some years ago. I cannot guarantee the accuracy of this contribution but I think it is more or less right. Any comments or corrections would be welcome. If anyone gets it to work they might like to send their code to Ictari for publication. ---------------------------------------------------------------------- To: Dick Teuber From: Iain McLeod In Reply to Dick Teuber's question on how to incorporate a .RSC file within a C file, Lattice C holds the answer. It has a utility program which converts the .RSC file to the equivalent structural information that it is referenced by in C code. You simply pass the name of the .RSC file to the 'RSC Decompiler' which does all this and also creates two functions: rsrc_init() - Call this function at the start of your program which calls fix_tree(), passing all your Form Dialogs each time. fix_tree() - This simply then calls the function rsrc_obfix(), passing all the items in the specified Form Dialog to fix its coordinates to pixels. So, as you can see, it is quite straightforward in that all you need to do is write the resource in by hand (time consuming and you will need a book for reference - I recommend Atari Compendium or the Lattice C Manual Book 1) and have a function to go through *all* the resource items and call rsrc_obfix() on them all, (you will of course still need to #include the .H header file). Writing the resource by hand isn't the most efficient way (!) so if you use the 'RSC Decompiler' utility (I would expect it's copyrighted to HiSOFT) or even if someone did their own Decompiler. I would expect the above applies to .S assembly files also in that simply using rsrc_obfix() and setting up the Form Dialogs in a dc.b/w manner will achieve the same result. I always use my .RSC files in this way (- you never know what folk will want to do with your .RSC files, the Vandals!) and it makes for less files in a final executable program. ---------------------------------------------------------------------- To: *.* From: Adrian Lovatt Plea - does anyone have a description of the CAD3D2 file format, I am writing a program to convert CAD objects into a format usable by POVRAY, but really need the file info. If anyone can help or has any ideas please get in touch. Has any HiSoft Basic programmer out there ever tried to put a Basic sub-program into the VBI list ?. ---------------------------------------------------------------------- To: Jonathon White From: Mark Baker Your comments on evnt_multi() in the GEM tutorial are rather misleading if not just wrong. Use of evnt_multi() does not freeze the system until it returns. It only freezes your program, and allows other programs to continue execution. In fact other programs can _only_ run during evnt_multi() in co-operative multitasking systems such as Geneva. So far from harming the multitasking, it is essential for a well behaved program to spend as much time as possible in evnt_multi() or another event library call. Because they take the program out of the evnt_multi(), timer events should be avoided if possible as they slow down everything. Obviously if you have to have them do so, but don't use any unnecessarily. When you should have timer events is on their own using an evnt_timer() call in the middle of a large block of processing. The real reason you can't access the menus when there is a dialogue box on screen is that you do a wind_update() to turn them off before you draw the dialogue. This is done deliberately to simplify the dialogue code. evnt_multi() obviously doesn't turn off the menus as that's what you normally use to detect menu events! Don't see this as an attack on your otherwise excellent series, it's just that I would hate to see anyone following your advice on timer events. ---------------------------------------------------------------------- To: *.* From: Tony Harris i) I need the routines to play Quartet songs in assembly, this is very urgent! ii) Does anyone know how to do sine waves in assembler? iii) This is a little embarassing, but what the hell is overscan and have I got one in my 1Mb STE, if so, how do I use it, and if not, why not? */ AutoSwitch Overscan (as I understand it) is a hardware device which has to be fitted to the computer and effectively makes the screen display larger. In the case of a monochrome monitor the screen area is changed to about 672 pixels wide by 480 pixels high and so can display more information on screen than a normal display. Unfortunately a lot a of programs do not take advantage of the extra area so it is not much use on these programs. I think Calamus does make use of the extra area and I would guess that some of the modern WordProcessors and CAD programs do, you would have to check before buying one. The hardware is available from Compo Software Ltd in Huntingdon for about 50 and there was a review published in Issue 6 of ST Applications magazine. Whether it works on an STE I don't know but Compo should be able to tell you. Another system works purely in software and allows the programmer to use the top, bottom and side borders to a certain extent and we will be publishing some routines to do this from Diamond Software next month, but don't ask me how it works because I still don't understand it. If anyone wishes to add more on the subject, please send it in to us. ICTARI /* ---------------------------------------------------------------------- To: ICTARI From: Martyn Wells I am writing a program which uses Videomaster format files i.e. VID, FLM, VSQ but I am having trouble with the colours in the files as these are written in the Amiga format xxxxrrrr/ggggbbbb. Is there a quick way of converting them to the Degas format without using lookup tables as the film files are quite large sometimes and I need to save as much memory space as possible. --------------------------- End of file ------------------------------ ICTARI PROGRAMMERS USER GROUP ============================= METHODS OF PAYMENT We will be using two basic systems for exchanging disks. You can either send a disk to us each month together with the return postage or you can send money and we will provide a disk from that. If you send a disk please erase any old data on it so that we don't have to check through it again to see if there is anything new being returned. If possible some new material for the magazine would be very useful, even if it is just a letter about some aspect of programming, requests for help or comments about the group. With the disk please enclose two second class stamps (or the money equivalent) to pay for the return postage and packing. Don't forget to write your name and address on the disk or we may not know where to send it. Alternatively you can send 75p for each month that you wish to pay for in advance. Any cheques or postal orders should be made payable to :- Mr P D Hibbs. Of the two methods, we would prefer the first one because this means we don't have to keep buying dozens of disks each month and also it is more likely that members will put something on the disk for the magazine. The only slight drawback is that members have to remember to return the disk each month. We would suggest that you buy a book of stamps and a packet of envelopes in readiness and also return the disk as soon as you can after you receive it to avoid any problems. If you do send money and then send a disk with a contribution for the magazine, your credit will be adjusted accordingly. The credit system means that a disk+stamps or 75p is worth one credit. When your credit rating is zero you will be informed so that you can send more disks/money as you wish. For overseas members in Europe please send 1 per disk or if you are sending a disk please include an international postal coupon to cover the cost of sending the disk magazine. Countries outside Europe may need more postage. Back issues of the magazine are available from us for 1 per disk. The address for ICTARI is :- 63 Woolsbridge Road, Ashley Heath, Ringwood, Hants, BH24 2LX. (Please note that this document will not change each month unless mentioned in the ICTARI.TXT document file) ----------------