'TAD The Amos Department, designed and programmed by Colinoo in Dec93/March94. ' !! AMOS PRO ONLY !! ' For ideas and bugs, contact me to: ' Nicolas Richard 1921 Massachusets Ave St Petersburg FL 33703 USA ' V1.4 ' >The "Spread" function finally works!!!! ' >Pack & Unpack pictures!!!! 'SC=0 => screen not opened 'NECRAN => number of the active screen (4 to 7) Global SC,OLD,OLD_C,PICKTEST,NECRAN,MEM,BEGIN,FINISH NECRAN=4 'There are 3 sprites you can grab 'I use the resource bank supplied with the Amos Pro package Resource Bank 16 Resource Screen Open 0,640,60,0 Change Mouse 4 Limit Mouse 0,0 To 500,500 Flash Off : Curs Off : Cls 5 Palette ,,,,$534,$978,$DBC,$FFF 'Buttons definition... A lot of work, isn't it? A$=A$+"BUtton 1,XB60+,5,56,14,0,0,1;[UN0,0,BP45+;PR9,3,'QUIT',8;][BR0;BQ;]" A$=A$+"BUtton 2,XB,5,56,14,0,0,1;[UN0,0,BP49+;PR9,3,'Load',8;][BR0;]" A$=A$+"BUtton 3,XB,5,56,14,0,0,1;[UN0,0,BP49+;PR9,3,'Save',8;][BR0;]" A$=A$+"BUtton 4,XB50+,5,56,14,0,0,1;[UN0,0,BP49+;PR3,3,'Ext R',8;][BR0;]" A$=A$+"BUtton 5,XB,5,56,14,0,0,1;[UN0,0,BP49+;PR3,3,'Ext G',8;][BR0;]" A$=A$+"BUtton 6,XB,5,56,14,0,0,1;[UN0,0,BP49+;PR3,3,'Ext B',8;][BR0;]" A$=A$+"BUtton 7,XB60-,21,56,14,0,0,1;[UN0,0,BP49+;PR12,3,'RGB',8;][BR0;]" A$=A$+"BUtton 8,XB165-,21,56,14,0,0,1;[UN0,0,BP49+;PR10,3,'Inv',8;][BR0;]" A$=A$+"BUtton 9,XB,21,56,14,0,0,1;[UN0,0,BP49+;PR10,3,'Rnd',8;][BR0;]" A$=A$+"BUtton 10,XB275-,21,56,14,0,0,1;[UN0,0,BP49+;PR6,3,'LoadP',8;][BR0;]" A$=A$+"BUtton 11,XB,21,56,14,0,0,1;[UN0,0,BP49+;PR6,3,'SaveP',8;][BR0;]" A$=A$+"BUtton 12,XB265+,37,56,14,0,0,1;[UN0,0,BP49+;PR1,3,'Reform',8;][BR0;]" A$=A$+"BUtton 13,XB485-,21,56,14,0,0,1;[UN0,0,BP49+;PR6,3,'Edit',8;][BR0;]" A$=A$+"BUtton 14,XB155+,37,56,14,0,0,1;[UN0,0,BP49+;PR8,3,'Lores',8;][BR0;]" A$=A$+"BUtton 15,XB,37,56,14,0,0,1;[UN0,0,BP49+;PR7,3,'Hires',8;][BR0;]" A$=A$+"BUtton 16,XB,37,56,14,0,0,1;[UN0,0,BP49+;PR6,3,'Laced',8;][BR0;]" A$=A$+"BUtton 17,XB380-,37,56,14,0,0,1;[UN0,0,BP47+;PR12,3,'PAL',8;][BR0;]" A$=A$+"BUtton 18,XB,37,56,14,0,0,1;[UN0,0,BP47+;PR8,3,'NTSC',8;][BR0;]" A$=A$+"BUtton 19,XB,37,56,14,0,0,1;[UN0,0,BP49+;PR8,3,'Pack',8;][BR0;]" A$=A$+"BUtton 20,XB260+,5,56,14,0,0,1;[UN0,0,BP49+;PR2,3,'Flip X',8;][BR0;]" A$=A$+"BUtton 21,XB50-,21,56,14,0,0,1;[UN0,0,BP49+;PR0,3,'Flip Y',8;][BR0;]" A$=A$+"BUtton 22,XB28+,14,15,10,0,0,1;[UN0,0,BP34+;][BR0;]" A$=A$+"BUtton 23,XB15-,35,20,10,0,0,1;[UN0,0,BP36+;][BR0;]" A$=A$+"EXit;" 'Dialogue Box definition B$=B$+"SetVar 2,1VA;" B$=B$+"SetVar 3,' Info ';" B$=B$+"SIze 3VATW160+,60;" B$=B$+"BAse SWidth SX -2/,SHeight SY- 2/;" B$=B$+"SAve 2;" B$=B$+"BOx 0,0,1,SX,SY;" B$=B$+"POutline 3VACX,10,3VA,0,14;" B$=B$+"PRint 2VACX,YB4+,2VA,1;" B$=B$+"BUtton 1,SX185-,SY24-,56,14,0,0,1;[UN 0,0,BP47+;PR 14,3,'OK',12;][BQ;]" B$=B$+"RUn 0,3;" B$=B$+"EXit;" 'Start the main interface program Dialog Open 1,A$ X=Dialog Run(1) Ink 7 Paper 5 : Pen 4 : Set Paint 1 'Info message Wait Vbl Change Mouse 5 A=Dialog Box(B$,,"TAD v1.4 - May 94 by Colinoo") Change Mouse 4 'Main loop Do Wait Vbl 'You can scroll the screen with the RMB If Mouse Key=2 Then Screen Display 0,,Y Mouse,, D=Dialog(1) : Exit If D<0 On D Gosub BUT1,BUT2,BUT3,BUT4,BUT5,BUT6,BUT7,BUT8,BUT9,BUT10,BUT11,BUT12,BUT13,BUT14,BUT15,BUT16,BUT17,BUT18,BUT19,BUT20,BUT21,BUT22,BUT23 Loop FINI BUT1: BUT2: A=Dialog Box(B$,,"Load an IFF file... ") : LOD : Return BUT3: A=Dialog Box(B$,,"Save current screen... ") : SAUVE[1] : Return BUT4: A=Dialog Box(B$,,"Extract Red from current screen ") : EXTRAIT[$F00] : Return BUT5: A=Dialog Box(B$,,"Extract Green from current screen ") : EXTRAIT[$F0] : Return BUT6: A=Dialog Box(B$,,"Extract Blue from current screen ") : EXTRAIT[$F] : Return BUT7: A=Dialog Box(B$,,"Extract RGB from current screen ") : FILTRE : Return BUT8: A=Dialog Box(B$,,"Inverse palette of current screen ") : INVERSE : Return BUT9: A=Dialog Box(B$,,"Generate random palette ") : HAZARD : Return BUT10: A=Dialog Box(B$,,"Load another palette... ") : LODP : Return BUT11: A=Dialog Box(B$,,"Save current palette... ") : SAUVEP : Return BUT12: A=Dialog Box(B$,,"Reform current screen ") : RETRECI : Return BUT13: A=Dialog Box(B$,,"Edit palette ") : Dialog Freeze(1) : PAL : Dialog Unfreeze(1) : Return BUT14: A=Dialog Box(B$,,"Reformat in Lores ") : LORES : Return BUT15: A=Dialog Box(B$,,"Reformat in Hires (16 colors max)") : HRES : Return BUT16: A=Dialog Box(B$,,"Interlaced mode On/Off ") : ENTRELACE : Return BUT17: A=Dialog Box(B$,,"Switch PAL mode ") : Poke $DFF1DC,$20 : Return BUT18: A=Dialog Box(B$,,"Switch NTSC mode ") : Poke $DFF1DC,0 : Return BUT19: A=Dialog Box(B$,,"Pack picture... ") : Dialog Freeze(1) : PAK : Dialog Unfreeze(1) : Return BUT20: A=Dialog Box(B$,,"Flip screen horizontally ") : Proc FLIPX : Return BUT21: A=Dialog Box(B$,,"Flip screen vertically ") : FLIPY : Return BUT22: ECRAN_UP : Return BUT23: ECRAN_DO : Return 'Note: NTSC mode => Poke $DFF1DC,$20 ' PAL mode => " " ,$00 'Very useful!!! 'Load a picture Procedure LOD Change Mouse 5 'Open file selector F$=Fsel$("","Iff file or packed picture!","Select a picture") 'If nothing is selected, then exit If F$="" Then Change Mouse 4 : Pop Proc Change Mouse 6 'You can load an IFF File (FORM....ILBM) or a packed picture (Pac.Pic) Open In 1,F$ 'I scan the first bytes of the file X$=Input$(1,20) 'Iff If Left$(X$,4)="FORM" 'Trap instruction in case of bad file Trap Load Iff F$,NECRAN End If 'Packed picture If Right$(X$,8)="Pac.Pic." 'Trap instruction in case of bad file Trap Load F$,10+NECRAN-4 Trap Unpack 10 To NECRAN End If Close 1 'If there's an error If Errtrap Then Change Mouse 4 : Boom : Pop Proc Screen To Front 0 Screen 0 SC=1 Change Mouse 4 End Proc 'Save a picture Procedure SAUVE[SN] 'If there's no screen opened, there is nothing to save! If SC=0 Then Pop Proc Change Mouse 5 'Open file selector F$=Fsel$("","","Save a picture/palette") If F$="" Then Change Mouse 4 : Pop Proc Change Mouse 6 'SN is the number of screen to save (1=>screen 2=>only palette) Screen SN : Trap Save Iff F$ Screen 0 Change Mouse 4 End Proc 'Extract RGB from screen Procedure EXTRAIT[RGB] If SC=0 Then Pop Proc Screen To Front NECRAN Screen NECRAN : Hide 'A simple >and< operation For I=0 To Screen Colour Colour I,Colour(I) and RGB Next I Screen To Front 0 : Screen 0 Show End Proc 'Inverse palette Procedure INVERSE If SC=0 Then Pop Proc Screen To Front NECRAN Screen NECRAN : Hide 'This is very simple, isn't it? For I=0 To Screen Colour Colour I,$FFF-Colour(I) Next I Show Screen To Front 0 : Screen 0 End Proc 'Random palette Procedure HAZARD If SC=0 Then Pop Proc Screen To Front NECRAN Screen NECRAN : Hide 'For each color, a random number between $0-$FFF is generated For I=0 To Screen Colour Colour I,Rnd($FFF) Next I Screen To Front 0 : Screen 0 Show End Proc 'Input for EXTRAIT procedure Procedure FILTRE 'This procedure input a custom filter for the EXTRAIT procedure '$F00 =>extract red '$0F0 => " green '$00F => " blue '$FF0 => " yellow 'etc... If SC=0 Then Pop Proc Get Cblock 1,0,40,640,8 Pen 4 Paper 5 Put Key "$" Locate ,5 : Input "Please enter a filter (Ex: $F4B) ";RGB Curs Off : Locate ,5 : Cline 40 Put Cblock 1 Del Cblock 1 EXTRAIT[RGB] End Proc 'Load palette Procedure LODP If SC=0 Then Pop Proc Change Mouse 5 F$=Fsel$("","Iff file only!","Select palette") If F$="" Then Change Mouse 4 : Pop Proc 'First, load the picture's palette into screen 2 Change Mouse 6 Trap Load Iff F$,2 If Errtrap Then Change Mouse 4 : Boom : Pop Proc Screen To Back 2 Screen NECRAN 'Then copy the palette of screen 2 to the current screen Get Palette 2 'Finally, close screen 2 Screen Close 2 Screen 0 Change Mouse 4 End Proc 'Save palette Procedure SAUVEP 'How can you save a palette?? There are 2 different ways: one difficult '(with print#, open in, open out, etc) and one quite simple (save iff). 'This is the solution I chose. I save a tiny blank screen (32*8) with 'the original palette: short, simple, and it works very well. If SC=0 Then Pop Proc Change Mouse 5 'open a second screen Screen Open 2,32,8,Screen Colour,Screen Mode Screen To Back 2 Screen 2 'Erase screen to save space (4 bytes for a 32 colors screen!) Cls 0 'Copy the original palette to the screen 2 Get Palette NECRAN 'Save the tiny screen with palette of the screen 1 SAUVE[2] 'Close the screen 2 Screen Close 2 Screen 0 Change Mouse 4 End Proc 'Lowres mode Procedure LORES If SC=0 Then Pop Proc Screen NECRAN 'If screen mode is already in Lowres, exit If Screen Mode=Lowres Then Screen 0 : Pop Proc Change Mouse 6 'Open a work screen in Lowres Screen Open 2,Screen Width,Screen Height,Screen Colour,Lowres : Flash Off 'Copy original picture to screen 2 Screen Copy NECRAN To 2 Screen 2 'Copy palette to screen 2 Get Palette NECRAN 'Close the original screen Screen Close NECRAN 'Now, open the new screen in Lowres mode Screen Open NECRAN,Screen Width,Screen Height,Screen Colour,Lowres Flash Off : Curs Off 'And copy work screen 2 to screen 1 Screen Copy 2 To NECRAN Screen NECRAN 'get palette Get Palette 2 'Close work screen Screen Close 2 Screen To Front 0 Screen 0 Change Mouse 4 End Proc 'Hires mode Procedure HRES 'This procedure is the same than above If SC=0 Then Pop Proc Screen NECRAN If Screen Mode=Hires Then Screen 0 : Pop Proc Change Mouse 6 '16 colors max If Screen Colour>16 SCOL=16 Else SCOL=Screen Colour End If Screen Open 2,Screen Width,Screen Height,SCOL,Hires : Flash Off Screen Copy NECRAN To 2 Screen 2 Get Palette NECRAN Screen Close NECRAN Screen Open NECRAN,Screen Width,Screen Height,SCOL,Hires Flash Off : Curs Off Screen Copy 2 To NECRAN Screen NECRAN Get Palette 2 Screen Close 2 Screen To Front 0 Screen 0 Change Mouse 4 End Proc 'Interlace mode (entrelace means "interlaced" in french) Procedure ENTRELACE If SC=0 Then Pop Proc Change Mouse 6 Screen NECRAN 'Is the screen interlaced or not? If Screen Mode=Lowres or Screen Mode=Hires SM=Laced+Screen Mode Else SM=Screen Mode-Laced End If 'Open a work screen Screen Open 2,Screen Width,Screen Height,Screen Colour,SM : Flash Off Screen Copy NECRAN To 2 Screen 2 Get Palette NECRAN Screen Open NECRAN,Screen Width,Screen Height,Screen Colour,Screen Mode Flash Off : Curs Off Screen NECRAN Get Palette 2 Screen Copy 2 To NECRAN Screen To Front 0 Screen Close 2 Screen 0 Change Mouse 4 End Proc 'Flip screen Procedure FLIPX 'This is VERY simple... If SC=0 Then Pop Proc Change Mouse 6 Screen NECRAN 'I get the screen as a bob... Get Bob NECRAN,7,0,0 To Screen Width,Screen Height Cls 0 'and I paste it with 'Hrev'!! Paste Bob 0,0,Hrev(7) 'I erase the bob bank to save memory Del Bob 7 Screen 0 Change Mouse 4 End Proc 'Flip screen Procedure FLIPY 'Same than above. If SC=0 Then Pop Proc Change Mouse 6 Screen NECRAN Get Bob NECRAN,7,0,0 To Screen Width,Screen Height Cls 0 'With Vrev, this time (see FLIPX) Paste Bob 0,0,Vrev(7) Del Bob 7 Screen 0 Change Mouse 4 End Proc 'Reform screen Procedure RETRECI If SC=0 Then Pop Proc Dialog Freeze 1 Screen To Back 0 Screen NECRAN Repeat Gr Writing 2 Box 0,0 To GX,GY GX=X Screen(X Mouse) : GY=Y Screen(Y Mouse) Box 0,0 To GX,GY Until Mouse Key=1 Gr Writing 1 Screen Open 2,Screen Width,Screen Height,Screen Colour,Screen Mode Change Mouse 6 'This is simple: I use the Zoom instruction. A bit slow, maybe... ' The active screen is shrunk to the screen 2. Zoom NECRAN,0,0,Screen Width,Screen Height To 2,0,0,GX,GY Screen Copy 2 To NECRAN Screen Close 2 Screen To Front 0 Change Mouse 4 Screen 0 Dialog Unfreeze 1 End Proc 'You can control up to 4 different screens Procedure ECRAN_UP '7 is the max number for a screen ' To use many screens: select a number between 1 and 4 with the red arrows ' (right of the screen). Click on "Load" and load your picture. Select ' another number and re-load another picture. Now by clicking on the ' arrows, you can flip between 4 screens. They are completely independant. If NECRAN=7 Then Pop Proc Inc NECRAN Ink 3,5 Gr Writing 1 Text 571,31,Str$(NECRAN-3) Gr Writing 0 Trap Screen To Front NECRAN Screen To Front 0 End Proc Procedure ECRAN_DO 'Same than above, but in the reverse order If NECRAN=4 Then Pop Proc Dec NECRAN Ink 3,5 Gr Writing 1 Text 571,31,Str$(NECRAN-3) Gr Writing 0 Trap Screen To Front NECRAN Screen To Front 0 End Proc 'This is the end. Procedure FINI For I=0 To 7 Trap Screen Close I Next I For I=10 To 14 Erase I Next I Dialog Close Edit 'Good bye! I hope you liked this program. Send me mail: I LOVE mail! ' How old are you? I'm 16 year old, man... ' For >FREE< upgrades, send me a disk with an old version of TAD, ' you will receive the newest version! No money asked! End Proc '-------------------------------------------------------------------------- 'Edit palette ' To change a color: ' 1) click on the appropriate color ' 2) modify it with the sliders ' 3) click on the 'Accept' button Procedure PAL 'NOTE: in EHB mode (64 colors), you can edit 32 colors only. ' I'm waiting for the AGA version of Amos Pro. ' Hey, François!! Hurry up! Blitz Basic 2 IS AGA COMPATIBLE!!!! If SC=0 Then Pop Proc Change Mouse 6 Screen Hide 0 'Interface definition 'Buttons: D$=D$+"BUtton 1,XB230+,5,56,14,0,0,1;[UN0,0,BP45+;PR14,3,'OK',8;][BR0;]" D$=D$+"BUtton 2,XB5+,5,56,14,0,0,1;[UN0,0,BP47+;PR8,3,'Stop',8;][BR0;]" D$=D$+"BUtton 3,XB10+,5,56,14,0,0,1;[UN0,0,BP49+;PR6,3,'Pick',8;][BR0;]" D$=D$+"BUtton 4,XB5+,5,56,14,0,0,1;[UN0,0,BP49+;PR2,3,'Accept',8;][BR0;]" D$=D$+"BUtton 5,XB250-,25,56,14,0,0,1;[UN0,0,BP49+;PR20,3,'Ex',8;][BR0;]" D$=D$+"BUtton 6,XB10+,25,56,14,0,0,1;[UN0,0,BP49+;PR11,3,'Copy',8;][BR0;]" D$=D$+"BUtton 7,XB10+,25,56,14,0,0,1;[UN0,0,BP49+;PR8,3,'Undo',8;][BR0;]" D$=D$+"BUtton 8,XB10+,25,56,14,0,0,1;[UN0,0,BP49+;PR0,3,'Spread',8;][BR0;]" D$=D$+"BUtton 9,XB5+,25,56,14,0,0,1;[UN0,0,BP43+;PR6,3,'Store',8;][BR0;]" D$=D$+"BUtton 10,XB55-,5,56,14,0,0,1;[UN0,0,BP43+;PR0,3,'Rstore',8;][BR0;]" D$=D$+"BUtton 11,XB80+,8,15,10,0,0,1;[UN0,0,BP34+;][BR0;]" D$=D$+"BUtton 12,XB15-,28,20,10,0,0,1;[UN0,0,BP36+;][BR0;]" 'And sliders: D$=D$+"LIne 20,1,65,198;" D$=D$+"HSlider 13,25,5,160,8,0,1,16,1;[]" D$=D$+"LIne 20,15,65,198;" D$=D$+"HSlider 14,25,19,160,8,0,1,16,1;[]" D$=D$+"LIne 20,29,65,198;" D$=D$+"HSlider 15,25,33,160,8,0,1,16,1;[]" D$=D$+"EXit;" Screen NECRAN SCR=Screen Colour 'This array is used for the 'Stop' instruction Dim RESET(SCR) For I=0 To SCR-1 RESET(I)=Colour(I) Next I 'open a screen to display all the colors Screen Open 2,320,21,SCR,Lowres Flash Off : Curs Off 'Copy palette 1 to screen 2 Get Palette NECRAN LONG=320/SCR H=20 Reserve Zone SCR 'If there are 64 colors, there will be 2 rows of colors If SCR=64 SCR=32 ROW=1 LONG=10 H=10 End If 'And fill this screen with plenty of beautiful colors For R=0 To ROW For I=0 To SCR-1 Ink ENC+I Bar I*LONG,R*H To LONG+I*LONG,H+R*H Ink 3 Box I*LONG,R*H To LONG+I*LONG,H+R*H 'ENC+I+1 because SetZone fails if the zone number is 0 Set Zone ENC+I+1,I*LONG+1,R*H To LONG+I*LONG-1,H+R*H Next I ENC=32 Next R 'Open another interface screen Resource Screen Open 3,640,46,0 : Cls 5 Screen Display 3,,72,, Ink 1 : Box 540,5 To 610,39 Ink 7 : Bar 541,6 To 609,38 Dialog Open 5,D$ W=Dialog Run(5) Change Mouse 4 'Main loop Do Wait Vbl 'Screen scrolling If Mouse Key=2 Screen Display 2,,Y Mouse,, Screen Display 3,,Y Mouse+22,, End If D=Dialog(5) MZ=Mouse Zone 'If the user click on a color... If(MZ<>0 and Mouse Click=1) or PICKTEST<>0 C=MZ-1 If PICKTEST<>0 C=PICKTEST PICKTEST=0 End If COUL=Colour(C) : Screen 3 : Colour 7,COUL 'update slider position ' >Red R=(COUL and $F00)/256 Dialog Update 5,13,R ' >Green G=(COUL and $F0)/16 Dialog Update 5,14,G ' >Blue B=COUL and $F Dialog Update 5,15,B End If 'If the user click on a slider, recalculate the color If D=13 or D=14 or D=15 R=Rdialog(5,13) G=Rdialog(5,14) B=Rdialog(5,15) Colour 7,R*256+G*16+B End If Screen 3 'Print the R G B values Gr Writing 1 Ink 3,5 : Text 200,11,Hex$(R) Ink 2 : Text 200,26,Hex$(G) Ink 1 : Text 200,40,Hex$(B) Gr Writing 0 Trap Screen Mouse Screen On D Gosub OK,HALT,PICK,ACCEPT,EX,COPIE,UNDO,SPREAD,BUFFER,RSTORE,PAL_UP,PAL_DO Loop OK: Proc OK : Pop Proc HALT: Trap Screen NECRAN For I=0 To SCR-1 Colour I,RESET(I) Next I Proc HALT : Pop Proc PICK: Proc PICK : Return ACCEPT: Proc ACCEPT[C] : Return EX: Proc EX[C] : Return COPIE: Proc COPIE[C] : Return UNDO: Proc UNDO : Return SPREAD: Proc SPREAD[C] : Return BUFFER: Proc BUFFER : Return RSTORE: Proc RSTORE : Return PAL_UP: Proc PAL_UP : Return PAL_DO: Proc PAL_DO : Return End Proc 'These procedures are relative to the palette: 'Exit from the palette Procedure OK Trap Screen NECRAN Get Palette 2 Screen Close 2 Screen Close 3 Screen Show 0 Screen To Front 0 'Don't forget to close the dialog channel Dialog Close 5 Screen 0 X Mouse=120 End Proc 'Cancel the palette Procedure HALT 'Same than above, except that the palette is lost Screen Close 2 Screen Close 3 Screen Show 0 Screen To Front 0 Dialog Close 5 Screen 0 X Mouse=120 End Proc 'Get color Procedure ACCEPT[C] CO=Colour(7) Screen 2 'OLD and OLD_C are the variables used for the 'undo' instruction OLD=Colour(C) OLD_C=C Colour C,CO Screen NECRAN Get Palette 2 Screen 3 End Proc 'Exchange colors Procedure EX[C] Screen 2 Change Mouse 5 Do MZ=Mouse Zone If MZ<>0 and Mouse Click=1 DC=Colour(MZ-1) Colour MZ-1,Colour(C) Colour C,DC PICKTEST=MZ-1 Change Mouse 4 Pop Proc End If Loop End Proc 'Copy a color to another Procedure COPIE[C] Screen 2 Change Mouse 5 Do MZ=Mouse Zone If MZ<>0 and Mouse Click=1 OLD=Colour(MZ-1) OLD_C=MZ-1 Colour MZ-1,Colour(C) Change Mouse 4 PICKTEST=MZ-1 Pop Proc End If Loop End Proc Procedure PICK Dialog Freeze 5 Screen To Front NECRAN Screen NECRAN Change Mouse 5 Repeat PICKTEST=Point(X Screen(X Mouse),Y Screen(Y Mouse)) Until Mouse Key=1 Screen To Front 2 Screen To Front 3 Screen 2 Change Mouse 4 Wait Vbl Dialog Unfreeze 5 End Proc Procedure UNDO Screen 2 Colour OLD_C,OLD Screen NECRAN Get Palette 2 Screen 3 End Proc 'Copy palette to memory (see inside) Procedure BUFFER 'Example: you want to import the palette of the screen #1 to the screen #2. ' You have 2 solutions: save it and reload it, or click on the ' 'Store' button. Select a range with the pointer. Then, go to ' the screen #2, edit the palette, and click on 'Rstore'. Change Mouse 5 Dialog Freeze Screen 2 'First wait loop: choose the first color Repeat MZ=Mouse Zone Until MZ<>0 and Mouse Click=1 BEGIN=MZ INDEX=BEGIN 'Second wait loop: choose the last color Repeat MZ=Mouse Zone Until MZ<>0 and Mouse Click=1 FINISH=MZ If FINISH0 and Mouse Click=1 HIGHX=MZ-1 Exit End If Loop LOW=Min(LOWX,HIGHX) HIGH=Max(LOWX,HIGHX) If HIGH-LOW=1 or HIGH=LOW Then Boom : Change Mouse 4 : Pop Proc For I=LOW+1 To HIGH-1 Colour I,0 Next 'It's not very simple, unfortunately... For I=0 To 2 CBEGIN=Val("$"+Mid$(Hex$(Colour(LOW),3),I+2,1)) CFINISH=Val("$"+Mid$(Hex$(Colour(HIGH),3),I+2,1)) COUL1#=(CFINISH-CBEGIN) COUL2#=(HIGH-LOW) COUL#=COUL1#/COUL2# MICOL=Min(CBEGIN,CFINISH) MACOL=Max(CBEGIN,CFINISH) For Z=1 To(HIGH-LOW-1) SCOL=CBEGIN+(Z*COUL#) If SCOL>=MACOL SCOL=MACOL Else If SCOL<=MICOL SCOL=MICOL End If Colour Z+LOW,SCOL*16^(2-I)+Colour(Z+LOW) Next Next Screen NECRAN Get Palette 2 Screen 3 Change Mouse 4 Dialog Unfreeze 5 End Proc '-------------------------------------------------------------------------- 'Pack screen as screen/bitmap Procedure PAK If SC=0 Then Pop Proc Change Mouse 6 'Open another interface screen Resource Screen Open 3,640,40,0 : Cls 5 Screen Hide 0 Screen Display 3,,72,, Flash Off : Curs Off 'Interface definition D$=D$+"BUtton 1,XB150+,5,56,14,0,0,1;[UN0,0,BP45+;PR14,3,'OK',8;][BR0;]" D$=D$+"BUtton 2,XB5+,5,56,14,0,0,1;[UN0,0,BP47+;PR1,3,'Screen',8;][BR0;]" D$=D$+"BUtton 3,XB10+,5,56,14,0,0,1;[UN0,0,BP47+;PR0,3,'Bitmap',8;][BR0;]" D$=D$+"BUtton 4,XB5+,5,56,14,0,0,1;[UN0,0,BP49+;PR1,3,'S-Bank',8;][BR0;]" D$=D$+"BUtton 5,XB10+,5,56,14,0,0,1;[UN0,0,BP49+;PR1,3,'S-Data',8;][BR0;]" D$=D$+"EXit;" Dialog Open 5,D$ W=Dialog Run(5) Change Mouse 4 'Number of the active bank ACT=10+NECRAN-4 'Main loop Do D=Dialog(5) Wait Vbl If Mouse Key=2 Then Screen Display 3,,Y Mouse,, On D Gosub OK,PAKS,PAKB,SAV,SAV Loop OK: Screen Close 3 : Screen Show 0 : Screen 0 : Dialog Close(5) : Pop Proc PAKS: Change Mouse 6 : Spack NECRAN To ACT : Proc INFO[ACT] : Return PAKB: Change Mouse 6 : Pack NECRAN To ACT : Proc INFO[ACT] : Return SAV: Proc SAVPAK[D,ACT] : Return End Proc 'Save bank or bitmap Procedure SAVPAK[TYPE,ACT] Change Mouse 5 If TYPE=4 '>Save memory bank F$=Fsel$("",".Abk","Save memory bank") If F$="" : Gosub FIN : End If Trap Save F$,ACT Else '>Save bitmap F$=Fsel$("",".Bin","Save bitmap") If F$="" : Gosub FIN : End If Trap Bsave F$,Start(ACT) To Start(ACT)+Length(ACT) End If If Errtrap Then Boom FIN: Change Mouse 4 End Proc 'Display info Procedure INFO[ACT] Gr Writing 1 Ink 3,5 : Text 160,30,"Size of packed file:"+Str$(Length(ACT))+" bytes." Gr Writing 0 Change Mouse 4 End Proc