home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / sourcecode / various / convformat.amos / convformat.amosSourceCode
AMOS Source Code  |  1991-09-09  |  8KB  |  258 lines
  1. Screen Open 0,320,256,16,Lowres : Rem especially for RAMOS 
  2. Rem ******************************************** 
  3. Rem ***** ConvFormat is at Version 1.0a ******** 
  4. Rem ******************************************** 
  5. Rem ** see about **
  6. Rem ***************
  7. INMEM=False
  8. REQON=True
  9. QUIT=False
  10. Print "Use Menus"
  11. Global QUIT,INMEM,REQON
  12. MENUDEF
  13. Do 
  14.    If QUIT Then Exit 
  15. Loop 
  16. Edit 
  17. Procedure ABOUT
  18.    Rem ******************************************** 
  19.    Rem ** This program is `Diskware' send me a   ** 
  20.    Rem ** with some PD on it, I'll return it ASAP** 
  21.    Rem ** and I'll return it with some of my PD  ** 
  22.    Rem ** NO PIRATES !!! You may modify this prog** 
  23.    Rem ** on condition that these REM statements ** 
  24.    Rem ** are left intact. If anyone improves    **   
  25.    Rem ** this version, update the version number** 
  26.    Rem ** accordingly. V1.1-> V1.1 a-> V1.1 b etc.* 
  27.    Rem ** and please send me a listing, and add  ** 
  28.    Rem ** your name below. (Any disks returned)  ** 
  29.    Rem ** ConvFormat V1.0a does not display      ** 
  30.    Rem ** interlace pics properly.               ** 
  31.    Rem ** Please detail any improvements in the  ** 
  32.    Rem ** Rem statements ************************** 
  33.    Rem ******************************************** 
  34.    Rem ** Mark Burbidge          I released      ** 
  35.    Rem ** 107 Heron Road,          V1.0          ** 
  36.    Rem ** Larkfield,                             ** 
  37.    Rem ** Kent,                                  ** 
  38.    Rem ** ENGLAND.                               ** 
  39.    Rem ** Features of V1.0.  Menu Control        ** 
  40.    Rem **                    IFF format          ** 
  41.    Rem **                    PCK format  (AMOS)  ** 
  42.    Rem **                    Auto File suffix    ** 
  43.    Rem **                    Friendly Requesters ** 
  44.    Rem ** Requester routine crashes, if the box  ** 
  45.    Rem ** must be longer than the screen to      ** 
  46.    Rem ** accomodate the text. Beware!!          ** 
  47.    Rem ******************************************** 
  48.    Rem ******************************************** 
  49.    Rem ********* Authors who updated this ********* 
  50.    Rem *************** program are **************** 
  51.    Rem ******************************************** 
  52. End Proc
  53. Procedure MENUDEF
  54.    Menu$(1)="Files"
  55.    Menu$(1,1)="Load Files"
  56.    Menu$(1,2)="Save Files"
  57.    Menu$(1,1,1)="Load .PCK"
  58.    Menu$(1,1,2)="Load .IFF"
  59.    Menu$(1,2,1)="Save as .PCK"
  60.    Menu$(1,2,2)="Save as .IFF"
  61.    If INMEM
  62.       Menu Active(1,2)
  63.       Menu Active(1,2,1)
  64.       Menu Active(1,2,2)
  65.    Else 
  66.       Menu Inactive(1,2)
  67.       Menu Inactive(1,2,1)
  68.       Menu Inactive(1,2,2)
  69.    End If 
  70.    Menu$(1,3)="Clear screen"
  71.    Menu$(1,4)="Quit"
  72.    On Menu Proc ACTION
  73.    On Menu On 
  74.    Menu On 
  75. End Proc
  76. Procedure LODEPCK
  77.    F$=Fsel$("*.PCK","","Choose a picture","to unpack")
  78.    If Not F$=""
  79.       Print "Loading..."
  80.       Load F$,5
  81.       Cls 
  82.       Print "Loaded."
  83.       Unpack 5 To 0
  84.       INMEM=True
  85.       Erase 5
  86.       MENUDEF
  87.    End If 
  88. End Proc
  89. Procedure LODEIFF
  90.    F$=Fsel$("*.IFF","","Choose a picture","to load")
  91.    If Not F$=""
  92.       Load Iff F$,0
  93.       INMEM=True
  94.       MENUDEF
  95.    End If 
  96. End Proc
  97. Procedure SAVPCK
  98.    REQ["Will you wait whilst I compress data?","Yes","No"]
  99.    If Param$="Yes"
  100.       Change Mouse 3
  101.       Spack 0 To 5
  102.       Change Mouse 1
  103.       F$=Fsel$("*.PCK","","Pick a filename","Any filename")
  104.       If Not(F$="")
  105.          If Not(Right$(F$,4)=".PCK")
  106.             F$=F$+".PCK"
  107.          End If 
  108.          Save F$,5
  109.       End If 
  110.       Erase 5
  111.    End If 
  112. End Proc
  113. Procedure SAVIFF
  114.    REQ["IFF Compression technique?","Yes","No"]
  115.    If Param$="Yes" Then COMP=True Else COMP=False
  116.    F$=Fsel$("*.IFF","","Pick a filename","Any Filename")
  117.    If Not F$=""
  118.       If Not(Right$(F$,4)=".IFF")
  119.          F$=F$+".IFF"
  120.       End If 
  121.       If COMP
  122.          Save Iff F$
  123.       Else 
  124.          Save Iff F$,0
  125.       End If 
  126.    End If 
  127. End Proc
  128. Procedure ACTION
  129.    If Choice
  130.       If Choice(1)=1
  131.          If Choice(2)=1
  132.             If Choice(3)=1
  133.                LODEPCK
  134.             End If 
  135.             If Choice(3)=2
  136.                LODEIFF
  137.             End If 
  138.          End If 
  139.          If Choice(2)=2
  140.             If Choice(3)=1
  141.                SAVPCK
  142.             End If 
  143.             If Choice(3)=2
  144.                SAVIFF
  145.             End If 
  146.          End If 
  147.          If Choice(2)=3
  148.             REQ["Positive?","Go for it!!","Leave it"]
  149.             If Left$(Param$,1)="G"
  150.                Cls 
  151.                INMEM=False
  152.                MENUDEF
  153.             End If 
  154.          End If 
  155.          If Choice(2)=4
  156.             REQ["Are you sure?","Yes","No"]
  157.             If Param$="Yes"
  158.                QUIT=True
  159.             End If 
  160.          End If 
  161.       End If 
  162.       On Menu On 
  163.    End If 
  164. End Proc
  165. Procedure REQ[MS$,V1$,V2$]
  166.    Rem *************************************
  167.    Rem **      REQUEST BOX CONTROLLER     **  
  168.    Rem *************************************
  169.    Rem **   PLEASE MAKE V1$ YOUR DEFAULT  **
  170.    Rem **   This will be returned if the  **
  171.    Rem **      boxes are turned off,      **
  172.    Rem **   MS$ is the box message, the   **          
  173.    Rem **         two are gadgets         **
  174.    Rem *************************************
  175.    If REQON
  176.       REQBOX[MS$,V1$,V2$]
  177.       V$=Param$
  178.    Else 
  179.       V$=V1$
  180.    End If 
  181. End Proc[V$]
  182. Procedure REQBOX[MES$,G1$,G2$]
  183.    Rem *********************************
  184.    Rem ***    Do that Request Box    ***
  185.    Rem *********************************
  186.    C1=Colour(1)
  187.    Colour 1,$A40
  188.    C2=Colour(2)
  189.    Colour 2,$FFF
  190.    A$=Left$(G1$,1) : Rem **** Work out first letters **** 
  191.    B$=Left$(G2$,1) : Rem **** in gadgets ***
  192.    If Asc(A$)>96 Then A$=Chr$(Asc(A$)-32) : Rem ***Convert case ***
  193.    If Asc(B$)>96 Then B$=Chr$(Asc(B$)-32) : Rem *** myself *** 
  194.    I=Len(MES$)+6 : Rem *** Work out title length ***
  195.    If I<(Len(G1$+G2$)+9) Then I=(Len(G1$+G2$)+9) : Rem ** see if it's **
  196.    Rem ******* Longer than the gadget lengths ******
  197.    J=I*8 : Rem Hash together a block save 
  198.    K=J/16
  199.    If Not(J=K*16)
  200.       J=J+8
  201.    End If 
  202.    J=J+16 : Rem to be sure of size 
  203.    Rem *********************************************************
  204.    Rem ** I used the blocks as they are quicker than windsave **
  205.    Rem ** I know on page 101 it says to create a Dummy window **
  206.    Rem ** But how? and if you could open the dummy window,    **
  207.    Rem ** without affecting the screen why didn't it do that  **
  208.    Rem **                     anyway?                         **
  209.    Rem *********************************************************
  210.    Get Block 1,0,0,J,80
  211.    Wind Open 1,0,0,I,8,1 : Rem ***Save background open box ***
  212.    Curs Off 
  213.    Flash Off 
  214.    Reserve Zone 2 : Rem ****reserve two Zones***** 
  215.    Window 1
  216.    Title Top MES$ : Rem ****Put in the box title***
  217.    Locate 2,3
  218.    Print Border$(Zone$(G1$,1),1) : Rem **** Add the gadgets *** 
  219.    T=I-Len(G2$)-4 : Rem *** Find posn of right gadget ***
  220.    Locate T,3
  221.    Print Border$(Zone$(G2$,2),1)
  222.    Repeat : Rem ***Wait for a response or a keypress ****
  223.       I=Mouse Key : Rem *** Keypress only works if first letters *** 
  224.       OK=((I=1) or(I=3)) : Rem *** are different ***
  225.       A=Mouse Zone
  226.       INZ=((1=A) or(2=A))
  227.       If Not(A$=B$)
  228.          X$=Inkey$
  229.          If Asc(X$)>96
  230.             X$=Chr$(Asc(X$)-32)
  231.          End If 
  232.          LETT=((X$=A$) or(X$=B$))
  233.          If LETT
  234.             If X$=A$
  235.                A=1
  236.             Else 
  237.                A=2
  238.             End If 
  239.          End If 
  240.       End If 
  241.    Until LETT or(OK and INZ)
  242.    Wind Close 
  243.    Rem *************************
  244.    Rem ** Put Background Back **
  245.    Rem *************************
  246.    Put Block 1
  247.    Del Block 1
  248.    Reset Zone 1
  249.    Reset Zone 2
  250.    If A=1
  251.       A$=G1$
  252.    Else 
  253.       A$=G2$
  254.    End If 
  255.    Colour 1,C1
  256.    Colour 2,C2
  257.    Rem ***** Return the selected variable ***** 
  258. End Proc[A$]