home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format 48 / af048b.adf / Autoexec.AMOS / Autoexec.amosSourceCode next >
AMOS Source Code  |  1993-05-11  |  25KB  |  1,000 lines
  1. ' ********************************************************************** 
  2. ' *                     VMorph Version 2.00 (Beta)                     * 
  3. ' *                                                                    * 
  4. ' *                       (c) 1992 - L.C.Wilkie                        * 
  5. ' ********************************************************************** 
  6. '
  7. '
  8. '
  9. '
  10. '
  11. Set Buffer 24 : Degree 
  12. '
  13. Screen Open 3,320,256,16,Lowres
  14. C=$0 : For F=0 To 15 : Colour(F),C : C=C+$111 : Next 
  15. Flash Off : Cls 0
  16. Screen Open 2,320,256,16,Lowres
  17. Flash Off : Get Palette 3 : Cls 0
  18. Screen Open 1,320,256,16,Lowres
  19. Flash Off : Get Palette 3 : Cls 0
  20. Screen Open 0,320,256,16,Lowres
  21. Change Mouse 2
  22. Flash Off : Get Palette 3 : Cls 0
  23. '
  24. Screen Open 4,640,80,4,Hires
  25. Change Mouse 2 : Flash Off 
  26. Screen Display 4,128,255+42-80,,
  27. Screen Hide 4
  28. Unpack 9 To 4
  29. Palette 0,0,0,0
  30. '
  31. Limit Mouse 128,42 To 127+320,42+255
  32. '
  33. ' ********************************************************************** 
  34. ' *                  Grid and render variables                         * 
  35. ' ********************************************************************** 
  36. '
  37. YES=1 : NO=0 : YES$="Yes" : NO$="No"
  38. SCALE#=8
  39. MXG#=32 : MYG#=32 : SXG=3 : SYG=3 : MXG=MXG# : MYG=MYG#
  40. XG#=SXG : YG#=SYG
  41. MIX=1 : PCNT#=0.5
  42. FRAMES#=10 : FRMNO#=0
  43. SOURCE=0 : DEST=1 : GRIDTYPE=SOURCE
  44. SBANK=8 : DBANK=9
  45. PANEL=1 : SNAME$=""
  46. '
  47. Dim GRID$(1,1)
  48. GRID$(SOURCE,0)="Source"
  49. GRID$(DEST,0)="  Dest"
  50. Dim GRID#(MXG,MYG,3)
  51. Dim XLLEN#(1)
  52. Dim YLLEN#(1)
  53. '
  54. Global GRID$(),GRID#(),XLLEN#(),YLLEN#()
  55. Global HYPOT#,PCNT#,MIX,GRIDTYPE,SOURCE,DEST,SBANK,DBANK,SCALE#
  56. Global SXG,SYG,MXG#,MYG#,MXG,MYG,XG#,YG#,FRAMES#,FRMNO#,PANEL
  57. Global X1#,Y1#,X2#,Y2#,X3#,Y3#,X4#,Y4#
  58. Global X12#,Y12#,X22#,Y22#,X32#,Y32#,X42#,Y42#
  59. Global YES,NO,YES$,NO$,SNAME$
  60. '
  61. ' ********************************************************************** 
  62. ' *                          Panel variables                           * 
  63. ' ********************************************************************** 
  64. '
  65. DP_RES$="" : DP_COL$="" : DP_INT$=NO$
  66. Dim R_MODE$(1) : R_MODE$(0)="Morph" : R_MODE$(1)="Warp" : R_MODE=0 : RM_MORPH=0 : RM_WARP=1
  67. Dim R_DSPL$(3) : R_DSPL$(0)="1/1" : R_DSPL$(1)="1/2" : R_DSPL$(2)="1/4" : R_DSPL$(3)="1/8" : R_DSPL=0
  68. Dim A_MODE$(1) : A_MODE$(0)="Anim" : A_MODE$(1)="Sngle" : A_MODE=1 : AM_ANIM=0 : AM_SINGLE=1
  69. A_END=9 : A_RSTART=1 : A_REND=8
  70. ' >> Start <<
  71. '
  72. Global DP_RES$,DP_COL$,DP_INT$
  73. Global R_MODE$(),R_MODE,RM_MORPH,RM_WARP
  74. Global R_DSPL$(),R_DSPL,A_MODE,A_MODE$(),AM_ANIM,AM_SINGLE
  75. Global A_END,A_RSTART,A_REND
  76. '
  77. ' ********************************************************************** 
  78. ' *                     Initialize some things                         * 
  79. ' ********************************************************************** 
  80. '
  81. INITGRID
  82. STZONES
  83. UDPANEL
  84. PANELTOP
  85. Screen Show 4
  86. Fade 1,$7A,$FFF,$0,$888
  87. LDIFF[0]
  88. LDIFF[1]
  89. DRWGRID
  90. '
  91. ' ********************************************************************** 
  92. ' *                         Main program loop                          *   
  93. ' ********************************************************************** 
  94. '
  95. Do 
  96.    Screen 0
  97.    MC=Mouse Click
  98.    XM=X Screen(X Mouse)
  99.    YM=Y Screen(Y Mouse)
  100.    Global XM,YM
  101.    '
  102.    If MC=1
  103.       If Scin(X Mouse,Y Mouse)=4
  104.          PANELACTION
  105.       Else 
  106.          MVEPNT
  107.       End If 
  108.    End If 
  109.    If MC=2
  110.       If XM=0
  111.          ADROW
  112.       Else 
  113.          If YM=0
  114.             ADCOL
  115.          Else 
  116.             SWPGRID
  117.          End If 
  118.       End If 
  119.    End If 
  120.    '
  121.    If Key State(64) Then TGPANEL
  122.    If Key State(55)
  123.       MORPH
  124.    End If 
  125.    If Key State(68)
  126.       Clear Key 
  127.       SWPGRID
  128.    End If 
  129.    '
  130. Loop 
  131. '
  132. '
  133. ' ********************************************************************** 
  134. ' *                  The 'Big' procedure section                       * 
  135. ' ********************************************************************** 
  136. '
  137. Procedure MORPH
  138.    '  
  139.    On Error Goto EH
  140.    '
  141.    If A_MODE=AM_ANIM
  142.       SVENAME
  143.       If SNAME$=""
  144.          MESS["No save name selected, can't continue"]
  145.          Wait 100
  146.          PANELTOP
  147.          Pop Proc
  148.       End If 
  149.    End If 
  150.    '
  151.    Screen Copy 2 To 0
  152.    Screen Copy 3 To 1
  153.    Screen To Front 4
  154.    '
  155.    A_REND#=A_REND
  156.    A_END#=A_END
  157.    A_FRAME#=A_RSTART
  158.    BLOCK$=Str$(Int(XG#)*Int(YG#))-" "
  159.    '
  160.    Do 
  161.       '
  162.       Screen 2 : Cls 0
  163.       Screen 3 : Cls 0
  164.       '
  165.       PCNT#=((100/A_REND#)*A_FRAME#)/100
  166.       TPCNT#=((100/A_END#)*A_FRAME#)/100
  167.       SPCNT#=PCNT#
  168.       DPCNT#=1-PCNT#
  169.       '
  170.       For Y=0 To YG#-1
  171.          For X=0 To XG#-1
  172.             '
  173.             If Mouse Key=3
  174.                MESS["Render aborted!"]
  175.                Wait 50
  176.                PANELTOP
  177.                Screen Copy 0 To 2
  178.                Screen Copy 1 To 3
  179.                DRWGRID
  180.                Screen To Front GRIDTYPE
  181.                Screen To Front 4
  182.                Pop Proc
  183.             End If 
  184.             '
  185.             M$=R_MODE$(R_MODE)
  186.             BLK$=Str$((Y*XG#)+X+1)+"/"+BLOCK$
  187.             MESS[M$+"ing frame"+Str$(Int(A_FRAME#))+" (a), block"+BLK$+"  (%"+Str$(TPCNT#*100)+" of Anim)..."]
  188.             '
  189.             X1#=GRID#(X,Y,0)
  190.             Y1#=GRID#(X,Y,1)
  191.             X2#=GRID#(X+1,Y,0)
  192.             Y2#=GRID#(X+1,Y,1)
  193.             X3#=GRID#(X+1,Y+1,0)
  194.             Y3#=GRID#(X+1,Y+1,1)
  195.             X4#=GRID#(X,Y+1,0)
  196.             Y4#=GRID#(X,Y+1,1)
  197.             '
  198.             X12#=GRID#(X,Y,2)+((GRID#(X,Y,0)-GRID#(X,Y,2))*DPCNT#)
  199.             Y12#=GRID#(X,Y,3)+((GRID#(X,Y,1)-GRID#(X,Y,3))*DPCNT#)
  200.             X22#=GRID#(X+1,Y,2)+((GRID#(X+1,Y,0)-GRID#(X+1,Y,2))*DPCNT#)
  201.             Y22#=GRID#(X+1,Y,3)+((GRID#(X+1,Y,1)-GRID#(X+1,Y,3))*DPCNT#)
  202.             X32#=GRID#(X+1,Y+1,2)+((GRID#(X+1,Y+1,0)-GRID#(X+1,Y+1,2))*DPCNT#)
  203.             Y32#=GRID#(X+1,Y+1,3)+((GRID#(X+1,Y+1,1)-GRID#(X+1,Y+1,3))*DPCNT#)
  204.             X42#=GRID#(X,Y+1,2)+((GRID#(X,Y+1,0)-GRID#(X,Y+1,2))*DPCNT#)
  205.             Y42#=GRID#(X,Y+1,3)+((GRID#(X,Y+1,1)-GRID#(X,Y+1,3))*DPCNT#)
  206.             '
  207.             If R_MODE=RM_MORPH
  208.                QUADCOPY[0,2]
  209.             Else 
  210.                QUADCOPY[0,3]
  211.                Goto NXT
  212.             End If 
  213.             '
  214.             MESS[M$+"ing frame"+Str$(Int(A_FRAME#))+" (b), block"+BLK$+"  (%"+Str$(TPCNT#*100)+" of Anim)..."]
  215.             '
  216.             X1#=GRID#(X,Y,2)
  217.             Y1#=GRID#(X,Y,3)
  218.             X2#=GRID#(X+1,Y,2)
  219.             Y2#=GRID#(X+1,Y,3)
  220.             X3#=GRID#(X+1,Y+1,2)
  221.             Y3#=GRID#(X+1,Y+1,3)
  222.             X4#=GRID#(X,Y+1,2)
  223.             Y4#=GRID#(X,Y+1,3)
  224.             '
  225.             X12#=GRID#(X,Y,0)+((GRID#(X,Y,2)-GRID#(X,Y,0))*SPCNT#)
  226.             Y12#=GRID#(X,Y,1)+((GRID#(X,Y,3)-GRID#(X,Y,1))*SPCNT#)
  227.             X22#=GRID#(X+1,Y,0)+((GRID#(X+1,Y,2)-GRID#(X+1,Y,0))*SPCNT#)
  228.             Y22#=GRID#(X+1,Y,1)+((GRID#(X+1,Y,3)-GRID#(X+1,Y,1))*SPCNT#)
  229.             X32#=GRID#(X+1,Y+1,0)+((GRID#(X+1,Y+1,2)-GRID#(X+1,Y+1,0))*SPCNT#)
  230.             Y32#=GRID#(X+1,Y+1,1)+((GRID#(X+1,Y+1,3)-GRID#(X+1,Y+1,1))*SPCNT#)
  231.             X42#=GRID#(X,Y+1,0)+((GRID#(X,Y+1,2)-GRID#(X,Y+1,0))*SPCNT#)
  232.             Y42#=GRID#(X,Y+1,1)+((GRID#(X,Y+1,3)-GRID#(X,Y+1,1))*SPCNT#)
  233.             '
  234.             QUADCOPY[1,3]
  235.             '
  236.             NXT:
  237.          Next 
  238.       Next 
  239.       '
  240.       If R_MODE=RM_MORPH
  241.          MESS["Mixing frames"+Str$(Int(A_FRAME#))+"(a+b), (%"+Str$(TPCNT#*100)+" of Anim)..."]
  242.          MIX[PCNT#]
  243.       End If 
  244.       '
  245.       If A_MODE=AM_SINGLE
  246.          MESS["Packing screen to buffer..."]
  247.          Spack 3 To 8
  248.          Exit 
  249.       End If 
  250.       '
  251.       MESS["Saving frame"+Str$(Int(A_FRAME#))+"..."]
  252.       Screen 3
  253.       Save Iff SNAME$+"."+Str$(Int(A_FRAME#))-" "
  254.       If A_FRAME#=A_REND Then Exit 
  255.       A_FRAME#=A_FRAME#+1
  256.    Loop 
  257.    '
  258.    MESS["All done"]
  259.    Wait 100
  260.    TIDY:
  261.    Screen Copy 0 To 2
  262.    Screen Copy 1 To 3
  263.    DRWGRID
  264.    Screen To Front GRIDTYPE
  265.    Screen To Front 4
  266.    PANELTOP
  267.    Pop Proc
  268.    '
  269.    EH:
  270.    If Errn=84
  271.       MESS["Disk write protected - Please un-protect and try again"]
  272.       Wait 100
  273.    Else 
  274.       MESS["ERROR!"]
  275.       Wait 50
  276.    End If 
  277.    Resume TIDY
  278.    '
  279. End Proc
  280. Procedure MVEPNT
  281. Screen GRIDTYPE
  282. XO=(GRIDTYPE*2)
  283. YO=(GRIDTYPE*2)+1
  284. For Y=0 To YG#
  285.    For X=0 To XG#
  286.       If Abs(XM-GRID#(X,Y,XO))<2
  287.          If Abs(YM-GRID#(X,Y,YO))<2
  288.             Gr Writing 2
  289.             While Mouse Click<1
  290.                XM=X Screen(X Mouse)
  291.                YM=Y Screen(Y Mouse)
  292.                If X>0
  293.                   Draw GRID#(X-1,Y,XO),GRID#(X-1,Y,YO) To XM,YM
  294.                   Draw GRID#(X-1,Y,XO),GRID#(X-1,Y,YO) To XM,YM
  295.                End If 
  296.                If Y>0
  297.                   Draw GRID#(X,Y-1,XO),GRID#(X,Y-1,YO) To XM,YM
  298.                   Draw GRID#(X,Y-1,XO),GRID#(X,Y-1,YO) To XM,YM
  299.                End If 
  300.                If X<XG#
  301.                   Draw GRID#(X+1,Y,XO),GRID#(X+1,Y,YO) To XM,YM
  302.                   Draw GRID#(X+1,Y,XO),GRID#(X+1,Y,YO) To XM,YM
  303.                End If 
  304.                If Y<YG#
  305.                   Draw GRID#(X,Y+1,XO),GRID#(X,Y+1,YO) To XM,YM
  306.                   Draw GRID#(X,Y+1,XO),GRID#(X,Y+1,YO) To XM,YM
  307.                End If 
  308.             Wend 
  309.             GRID#(X,Y,XO)=XM
  310.             GRID#(X,Y,YO)=YM
  311.             DRWGRID
  312. Pop Proc
  313.          End If 
  314.       End If 
  315.    Next 
  316. Next 
  317. End Proc
  318. Procedure ADROW
  319.    XO=(GRIDTYPE*2)
  320.    YO=(GRIDTYPE*2)+1
  321.    For Y=0 To YG#-1
  322.       Y1#=GRID#(0,Y,1)
  323.       Y2#=GRID#(0,Y+1,1)
  324.       If Y1#<YM
  325.          If Y2#>YM
  326.             YG#=YG#+1
  327.             If YG#>MYG#
  328.                MESS["Maximun rows reached"]
  329.                Wait 100
  330.                PANELTOP
  331.                Pop Proc
  332.             End If 
  333.             '
  334.             For YY=YG# To Y+2 Step -1
  335.                For X=0 To XG#
  336.                   GRID#(X,YY,0)=GRID#(X,YY-1,0)
  337.                   GRID#(X,YY,1)=GRID#(X,YY-1,1)
  338.                   GRID#(X,YY,2)=GRID#(X,YY-1,2)
  339.                   GRID#(X,YY,3)=GRID#(X,YY-1,3)
  340.                Next 
  341.             Next 
  342.             For X=0 To XG#
  343.                XD#=(GRID#(X,Y,0)-GRID#(X,Y+2,0))/2
  344.                YD#=(GRID#(X,Y,1)-GRID#(X,Y+2,1))/2
  345.                GRID#(X,Y+1,0)=GRID#(X,Y+1,0)+XD#
  346.                GRID#(X,Y+1,1)=GRID#(X,Y+1,1)+YD#
  347.                XD#=(GRID#(X,Y,2)-GRID#(X,Y+2,2))/2
  348.                YD#=(GRID#(X,Y,3)-GRID#(X,Y+2,3))/2
  349.                GRID#(X,Y+1,2)=GRID#(X,Y+1,2)+XD#
  350.                GRID#(X,Y+1,3)=GRID#(X,Y+1,3)+YD#
  351.             Next 
  352.             '
  353.             DRWGRID
  354.             TPRINT[618,36,14,Str$(Int(YG#))-" "]
  355.             Pop Proc
  356.          End If 
  357.       End If 
  358.    Next 
  359. End Proc
  360. Procedure ADCOL
  361.    XO=(GRIDTYPE*2)
  362.    YO=(GRIDTYPE*2)+1
  363.    For X=0 To XG#-1
  364.       X1#=GRID#(X,0,0)
  365.       X2#=GRID#(X+1,0,0)
  366.       If X1#<XM
  367.          If X2#>XM
  368.             XG#=XG#+1
  369.             If XG#>MXG#
  370.                MESS["Maximum columns reached"]
  371.                Wait 100
  372.                PANELTOP
  373.                Pop Proc
  374.             End If 
  375.             '
  376.             For Y=0 To YG#
  377.                For XX=XG# To X+2 Step -1
  378.                   GRID#(XX,Y,0)=GRID#(XX-1,Y,0)
  379.                   GRID#(XX,Y,1)=GRID#(XX-1,Y,1)
  380.                   GRID#(XX,Y,2)=GRID#(XX-1,Y,2)
  381.                   GRID#(XX,Y,3)=GRID#(XX-1,Y,3)
  382.                Next 
  383.             Next 
  384.             For Y=0 To YG#
  385.                XD#=(GRID#(X,Y,0)-GRID#(X+2,Y,0))/2
  386.                YD#=(GRID#(X,Y,1)-GRID#(X+2,Y,1))/2
  387.                GRID#(X+1,Y,0)=GRID#(X+1,Y,0)+XD#
  388.                GRID#(X+1,Y,1)=GRID#(X+1,Y,1)+YD#
  389.                XD#=(GRID#(X,Y,2)-GRID#(X+2,Y,2))/2
  390.                YD#=(GRID#(X,Y,3)-GRID#(X+2,Y,3))/2
  391.                GRID#(X+1,Y,2)=GRID#(X+1,Y,2)+XD#
  392.                GRID#(X+1,Y,3)=GRID#(X+1,Y,3)+YD#
  393.             Next 
  394.             '
  395.             DRWGRID
  396.             TPRINT[618,25,14,Str$(Int(XG#))-" "]
  397.             Pop Proc
  398.          End If 
  399.       End If 
  400.    Next 
  401. End Proc
  402. Procedure HYPOT[X#,Y#,XX#,YY#]
  403.    L1#=Abs(X#-XX#)
  404.    L2#=Abs(Y#-YY#)
  405.    HYPOT#=Sqr((L1#*L1#)+(L2#*L2#))
  406. End Proc
  407. Procedure MIX[P#]
  408.    '
  409.    XOFF=160-(160/SCALE#)
  410.    YOFF=128-(128/SCALE#)
  411.    '
  412.    For Y=0 To(256/SCALE#)-1
  413.       For X=0 To(320/SCALE#)-1
  414.          Screen 3 : P1=Point(X+XOFF,Y+YOFF)
  415.          Screen 2 : P2=Point(X+XOFF,Y+YOFF)
  416.          C1#=Colour(P1) and $F
  417.          C2#=Colour(P2) and $F
  418.          CD#=C1#-C2# : PD#=(CD#*P#)
  419.          C=Int(C2#+PD#)
  420.          Screen 3
  421.          Plot X+XOFF,Y+YOFF,C
  422.       Next 
  423.    Next 
  424. End Proc
  425. Procedure LDIFF[S]
  426.    Clear Key 
  427.    On Error Proc EHANDLER
  428.    Resume Label LDIFF
  429.    LDIFF:
  430.    If S=SOURCE Then S$="Select a Source image" Else S$="Select a Destination image"
  431.    NAME$=Fsel$("*.Iff","",S$)
  432.    If NAME$="" Then Pop Proc
  433.    If Not Exist(NAME$) Then Pop Proc
  434.    Screen S+2
  435.    Load Iff NAME$
  436.    '
  437.    For C=0 To 15
  438.       If Colour(C)<>C*$111
  439.          MESS["Palette order different - remapping... (2 mins)"]
  440.          For Y=0 To 254
  441.             For X=0 To 319
  442.                C=Colour(Point(X,Y))
  443.                Plot X,Y,C/$111
  444.             Next 
  445.          Next 
  446.          For F=0 To 15
  447.             Colour F,F*$111
  448.          Next 
  449.          Goto CPS
  450.       End If 
  451.    Next 
  452.    '
  453.    CPS:
  454.    '
  455.    Screen Copy S+2 To S
  456.    NAME$=Right$(NAME$,Len(NAME$)-Instr(NAME$,":"))
  457.    Do 
  458.       Z=Instr(NAME$,"/")
  459.       If Z=0
  460.          Exit 
  461.       Else 
  462.          NAME$=Right$(NAME$,Len(NAME$)-Z)
  463.       End If 
  464.    Loop 
  465.    GRID$(S,1)=NAME$
  466.    DRWGRID
  467.    PANELTOP
  468. End Proc
  469. Procedure QUADCOPY[S1,S2]
  470.    '
  471.    XOFF=160-(160/SCALE#)
  472.    YOFF=128-(128/SCALE#)
  473.    '
  474.    X12#=X12#/SCALE# : Y12#=Y12#/SCALE#
  475.    X22#=X22#/SCALE# : Y22#=Y22#/SCALE#
  476.    X32#=X32#/SCALE# : Y32#=Y32#/SCALE#
  477.    X42#=X42#/SCALE# : Y42#=Y42#/SCALE#
  478.    '
  479.    Screen To Front S2
  480.    Screen To Front 4
  481.    Screen S2
  482.    '
  483.    HYPOT[X12#,Y12#,X22#,Y22#] : XLLEN#(0)=HYPOT#
  484.    HYPOT[X22#,Y22#,X32#,Y32#] : YLLEN#(0)=HYPOT#
  485.    HYPOT[X32#,Y32#,X42#,Y42#] : XLLEN#(1)=HYPOT#
  486.    HYPOT[X42#,Y42#,X12#,Y12#] : YLLEN#(1)=HYPOT#
  487.    '
  488.    If XLLEN#(0)>XLLEN#(1) Then XDIV#=XLLEN#(0) Else XDIV#=XLLEN#(1)
  489.    If YLLEN#(0)>YLLEN#(1) Then YDIV#=YLLEN#(0) Else YDIV#=YLLEN#(1)
  490.    '
  491.    '
  492.    For C#=0 To YDIV#
  493.       '
  494.       LSX#=X1#+(((X4#-X1#)/YDIV#)*C#)
  495.       LSY#=Y1#+(((Y4#-Y1#)/YDIV#)*C#)
  496.       LEX#=X2#+(((X3#-X2#)/YDIV#)*C#)
  497.       LEY#=Y2#+(((Y3#-Y2#)/YDIV#)*C#)
  498.       '
  499.       LSX2#=X12#+(((X42#-X12#)/YDIV#)*C#)
  500.       LSY2#=Y12#+(((Y42#-Y12#)/YDIV#)*C#)
  501.       LEX2#=X22#+(((X32#-X22#)/YDIV#)*C#)
  502.       LEY2#=Y22#+(((Y32#-Y22#)/YDIV#)*C#)
  503.       '
  504.       '
  505.       For R#=0 To XDIV#
  506.          '
  507.          LX#=LSX#+(((LEX#-LSX#)/XDIV#)*R#)
  508.          LY#=LSY#+(((LEY#-LSY#)/XDIV#)*R#)
  509.          LX2#=LSX2#+(((LEX2#-LSX2#)/XDIV#)*R#)
  510.          LY2#=LSY2#+(((LEY2#-LSY2#)/XDIV#)*R#)
  511.          Screen S1
  512.          P=Point(LX#,LY#)
  513.          Screen S2 : 
  514.          Plot LX2#+XOFF,LY2#+YOFF,P
  515.          Plot LX2#+XOFF,LY2#+YOFF+1,P
  516.          '
  517.       Next 
  518.    Next 
  519. End Proc
  520. Procedure SVEMORPH
  521. SVENAME$=Fsel$("DF1:","Morph","Save Morph")
  522. If SVENAME$="" Then Pop Proc
  523. End Proc
  524. Procedure PANELTOP
  525.    A$="VMorph V2 (Beta)  "+GRID$(GRIDTYPE,0)+":"+GRID$(GRIDTYPE,1)
  526. MESS[A$]
  527. End Proc
  528. Procedure MESS[A$]
  529.    S=Screen
  530.    Screen 4
  531.    Ink 0,0 : Bar 18,1 To 622,8
  532.    Ink 1,0 : TB=Text Base
  533.    Text 18,1+TB,A$
  534.    Screen S
  535. End Proc
  536. Procedure INITGRID
  537.    XD#=(319/XG#)
  538.    YD#=(255/YG#)
  539.    X#=0 : Y#=0
  540.    For Y=0 To YG#
  541.       For X=0 To XG#
  542.          GRID#(X,Y,0)=X#
  543.          GRID#(X,Y,1)=Y#
  544.          GRID#(X,Y,2)=X#
  545.          GRID#(X,Y,3)=Y#
  546.          X#=X#+XD#
  547.       Next 
  548.       X#=0
  549.       Y#=Y#+YD#
  550.    Next 
  551. End Proc
  552. Procedure DRWGRID
  553.    Screen Copy GRIDTYPE+2 To GRIDTYPE
  554.    Screen GRIDTYPE
  555.    XO=(GRIDTYPE*2)
  556.    YO=(GRIDTYPE*2)+1
  557.    Gr Writing 2
  558.    Ink 15
  559.    For YY=0 To YG#-1
  560.       For XX=0 To XG#
  561.          Draw GRID#(XX,YY,XO),GRID#(XX,YY,YO) To GRID#(XX,YY+1,XO),GRID#(XX,YY+1,YO)
  562.       Next 
  563.    Next 
  564.    For YY=0 To YG#
  565.       For XX=0 To XG#-1
  566.          Draw GRID#(XX,YY,XO),GRID#(XX,YY,YO) To GRID#(XX+1,YY,XO),GRID#(XX+1,YY,YO)
  567.       Next 
  568.    Next 
  569.    Gr Writing 1
  570. End Proc
  571. Procedure SWPGRID
  572.    GRIDTYPE=GRIDTYPE xor 1
  573.    DRWGRID
  574.    Screen To Front GRIDTYPE
  575.    Screen To Front 4
  576.    PANELTOP
  577. End Proc
  578. Procedure TGPANEL
  579.    If PANEL=1
  580.       Screen Hide 4
  581.       PANEL=0
  582.       Wait 5
  583.    Else 
  584.       Screen To Front 4
  585.       Screen Show 4
  586.       PANEL=1
  587.       Wait 5
  588.    End If 
  589. End Proc
  590. Procedure STZONES
  591.    Wait 50
  592.    Reserve Zone 23
  593.    Screen 4 : Ink 1
  594.    For Z=0 To 22
  595.       Read X,Y,W,H
  596.       Set Zone Z+1,X,Y To X+W,Y+H
  597.    Next 
  598.    Data 0,0,15,9
  599.    Data 624,0,15,9
  600.    Data 158,24,16,9
  601.    Data 158,35,16,9
  602.    Data 158,46,16,9
  603.    Data 158,57,16,9
  604.    Data 275,24,16,9
  605.    Data 275,68,16,9
  606.    Data 321,68,16,9
  607.    Data 275,46,16,9
  608.    Data 321,46,16,9
  609.    Data 275,57,16,9
  610.    Data 321,57,16,9
  611.    Data 424,24,16,9
  612.    Data 424,35,16,9
  613.    Data 424,46,16,9
  614.    Data 523,24,16,9
  615.    Data 523,35,16,9
  616.    Data 506,46,16,9
  617.    Data 540,46,16,9
  618.    Data 506,57,16,9
  619.    Data 540,57,16,9
  620.    Data 424,57,16,9
  621. End Proc
  622. Procedure SHADIN[X,Y,W,H]
  623. Screen 4
  624. Ink 1 : Polyline X+1,Y+H To X+W,Y+H To X+W,Y+1
  625. Ink 2 : Polyline X,Y+H-1 To X,Y To X+W-1,Y
  626. End Proc
  627. Procedure SHADOUT[X,Y,W,H]
  628. Screen 4
  629. Ink 2 : Polyline X+1,Y+H To X+W,Y+H To X+W,Y+1
  630. Ink 1 : Polyline X,Y+H-1 To X,Y To X+W-1,Y
  631. End Proc
  632. Procedure UDPANEL
  633.    TPRINT[34,25,76,"320x256"]
  634.    TPRINT[34,36,76,"16"]
  635.    TPRINT[34,47,76,NO$]
  636.    '
  637.    TPRINT[176,25,42,R_MODE$(R_MODE)]
  638.    TPRINT[176,36,42,R_DSPL$(R_DSPL)]
  639.    '
  640.    TPRINT[293,25,42,A_MODE$(A_MODE)]
  641.    TPRINT[293,36,26,"0"]
  642.    TPRINT[293,47,26,Str$(A_END)-" "]
  643.    TPRINT[293,58,26,Str$(A_RSTART)-" "]
  644.    TPRINT[293,69,26,Str$(A_REND)-" "]
  645.    '
  646.    TPRINT[524,47,14,Str$(SXG)-" "]
  647.    TPRINT[524,58,14,Str$(SYG)-" "]
  648.    '
  649.    TPRINT[618,25,14,Str$(Int(XG#))-" "]
  650.    TPRINT[618,36,14,Str$(Int(YG#))-" "]
  651. End Proc
  652. Procedure TPRINT[X,Y,W,A$]
  653. Screen 4
  654. Ink 0
  655. Bar X,Y To X+W,Y+7
  656. Ink 1,0 : Text X,Y+Text Base,A$
  657. End Proc
  658. Procedure PANELACTION
  659.    On Error Goto EH
  660.    Screen 4
  661.    MZ=Mouse Zone
  662.    '
  663.    ' >> Quit << 
  664.    '
  665.    If MZ=1
  666.       SHADIN[0,0,15,9]
  667.       While Mouse Key>0 : Wend 
  668.       MESS["Are you sure you want to quit? (Press Y or N)"]
  669.       Do 
  670.          If Key State(21)
  671.             Exit 
  672.          End If 
  673.          If Key State(54)
  674.             SHADOUT[0,0,15,9]
  675.             PANELTOP
  676.             Pop Proc
  677.          End If 
  678.       Loop 
  679.       SHADOUT[0,0,15,9]
  680.       Fade 1,0,0,0,0
  681.       Wait 25
  682.       Direct 
  683.    End If 
  684.    '
  685.    ' >> Cycle render mode <<
  686.    '
  687.    If MZ=3
  688.       SHADIN[158,24,16,9]
  689.       While Mouse Key>0 : Wend 
  690.       Inc R_MODE : R_MODE=R_MODE and $1
  691.       TPRINT[176,25,42,R_MODE$(R_MODE)]
  692.       SHADOUT[158,24,16,9]
  693.    End If 
  694.    '
  695.    ' >> Cycle display size << 
  696.    '
  697.    If MZ=4
  698.       SHADIN[158,35,16,9]
  699.       While Mouse Key>0 : Wend 
  700.       Inc R_DSPL : R_DSPL=R_DSPL and $3
  701.       SCALE#=Val(Right$(R_DSPL$(R_DSPL),1))
  702.       TPRINT[176,36,42,R_DSPL$(R_DSPL)]
  703.       SHADOUT[158,35,16,9]
  704.    End If 
  705.    '
  706.    ' >> Render start << 
  707.    '
  708.    If MZ=5
  709.       SHADIN[158,46,16,9]
  710.       While Mouse Key>0 : Wend 
  711.       SHADOUT[158,46,16,9]
  712.       Wait 5
  713.       MORPH
  714.    End If 
  715.    '
  716.    ' >> Cycle anim mode <<
  717.    '
  718.    If MZ=7
  719.       SHADIN[275,24,16,9]
  720.       While Mouse Key>0 : Wend 
  721.       Inc A_MODE : A_MODE=A_MODE and 1
  722.       TPRINT[293,25,42,A_MODE$(A_MODE)]
  723.       SHADOUT[275,24,16,9]
  724.    End If 
  725.    '
  726.    ' >> Dec range end <<  
  727.    '
  728.    If MZ=8
  729.       SHADIN[275,68,16,9]
  730.       While Mouse Key>0 : Wend 
  731.       If A_REND>A_RSTART
  732.          If A_REND>1
  733.             Dec A_REND
  734.             TPRINT[293,69,26,Str$(A_REND)-" "]
  735.          End If 
  736.       End If 
  737.       SHADOUT[275,68,16,9]
  738.    End If 
  739.    '
  740.    ' >> Inc range end <<  
  741.    '
  742.    If MZ=9
  743.       SHADIN[321,68,16,9]
  744.       While Mouse Key>0 : Wend 
  745.       If A_REND<A_END
  746.          Inc A_REND
  747.          TPRINT[293,69,26,Str$(A_REND)-" "]
  748.       End If 
  749.       SHADOUT[321,68,16,9]
  750.    End If 
  751.    '
  752.    ' >> Dec anim end << 
  753.    '
  754.    If MZ=10
  755.       SHADIN[275,46,16,9]
  756.       While Mouse Key>0 : Wend 
  757.       If A_END>1
  758.          Dec A_END
  759.          TPRINT[293,47,26,Str$(A_END)-" "]
  760.          If A_REND>A_END
  761.             A_REND=A_END
  762.             TPRINT[293,69,26,Str$(A_REND)-" "]
  763.          End If 
  764.       End If 
  765.       SHADOUT[275,46,16,9]
  766.    End If 
  767.    '
  768.    ' >> Inc anim end << 
  769.    '
  770.    If MZ=11
  771.       SHADIN[321,46,16,9]
  772.       While Mouse Key>0 : Wend 
  773.       If A_END<999
  774.          Inc A_END
  775.          TPRINT[293,47,26,Str$(A_END)-" "]
  776.       End If 
  777.       SHADOUT[321,46,16,9]
  778.    End If 
  779.    '
  780.    ' >> Dec range start <<
  781.    '
  782.    If MZ=12
  783.       SHADIN[275,57,16,9]
  784.       While Mouse Key>0 : Wend 
  785.       If A_RSTART>0
  786.          Dec A_RSTART
  787.          TPRINT[293,58,26,Str$(A_RSTART)-" "]
  788.       End If 
  789.       SHADOUT[275,57,16,9]
  790.    End If 
  791.    '
  792.    ' >> Inc range start <<
  793.    '
  794.    If MZ=13
  795.       SHADIN[321,57,16,9]
  796.       While Mouse Key>0 : Wend 
  797.       If A_RSTART<A_REND
  798.          Inc A_RSTART
  799.          TPRINT[293,58,26,Str$(A_RSTART)-" "]
  800.       End If 
  801.       SHADOUT[321,57,16,9]
  802.    End If 
  803.    '
  804.    ' >> Load Source <<
  805.    '
  806.    If MZ=14
  807.       SHADIN[424,24,16,9]
  808.       While Mouse Key>0 : Wend 
  809.       SHADOUT[424,24,16,9]
  810.       LDIFF[SOURCE]
  811.    End If 
  812.    '
  813.    ' >> Load Destination << 
  814.    '
  815.    If MZ=15
  816.       SHADIN[424,35,16,9]
  817.       While Mouse Key>0 : Wend 
  818.       SHADOUT[424,35,16,9]
  819.       LDIFF[DEST]
  820.    End If 
  821.    '
  822.    ' >> View Buffer <<  
  823.    '
  824.    If MZ=16
  825.       SHADIN[424,46,16,9]
  826.       If Length(8)>0
  827.          Unpack 8 To 3
  828.          While Mouse Key=0 : Wend 
  829.          Screen To Front 4
  830.          SHADOUT[424,46,16,9]
  831.          Screen Copy 1 To 3
  832.          Screen To Front GRIDTYPE
  833.          Screen To Front 4
  834.          Screen GRIDTYPE
  835.       Else 
  836.          While Mouse Key>0 : Wend 
  837.          Screen To Front 4
  838.          SHADOUT[424,46,16,9]
  839.          MESS["No image stored in buffer"]
  840.          Wait 100
  841.          PANELTOP
  842.       End If 
  843.    End If 
  844.    '
  845.    ' >> Save Buffer <<  
  846.    '
  847.    If MZ=23
  848.       SHADIN[424,57,16,9]
  849.       If Length(8)>0
  850.          SVENAME
  851.          If SNAME$=""
  852.             SHADOUT[424,57,16,9]
  853.             MESS["No save name selected, can't continue"]
  854.             Wait 100
  855.             PANELTOP
  856.             Pop Proc
  857.          End If 
  858.          Unpack 8 To 3
  859.          MESS["Saving buffer..."]
  860.          Screen 3
  861.          Save Iff SNAME$
  862.          Screen To Front 4
  863.          SHADOUT[424,57,16,9]
  864.          PANELTOP
  865.          Screen Copy 1 To 3
  866.          Screen To Front GRIDTYPE
  867.          Screen To Front 4
  868.          Screen GRIDTYPE
  869.       Else 
  870.          While Mouse Key>0 : Wend 
  871.          Screen To Front 4
  872.          SHADOUT[424,57,16,9]
  873.          MESS["No image stored in buffer"]
  874.          Wait 100
  875.          PANELTOP
  876.       End If 
  877.    End If 
  878.    '
  879.    ' >> Swap grids << 
  880.    '
  881.    If MZ=17
  882.       SHADIN[523,24,16,9]
  883.       While Mouse Key>0 : Wend 
  884.       SHADOUT[523,24,16,9]
  885.       SWPGRID
  886.    End If 
  887.    '
  888.    ' >> Reset grids <<  
  889.    '
  890.    If MZ=18
  891.       SHADIN[523,35,16,9]
  892.       While Mouse Key>0 : Wend 
  893.       SHADOUT[523,35,16,9]
  894.       XG#=SXG
  895.       YG#=SYG
  896.       TPRINT[618,25,14,Str$(Int(XG#))-" "]
  897.       TPRINT[618,36,14,Str$(Int(YG#))-" "]
  898.       INITGRID
  899.       DRWGRID
  900.    End If 
  901.    '
  902.    ' >> Dec X reset <<
  903.    '
  904.    If MZ=19
  905.       SHADIN[506,46,16,9]
  906.       While Mouse Key>0 : Wend 
  907.       If SXG>1
  908.          Dec SXG
  909.          TPRINT[524,47,14,Str$(SXG)-" "]
  910.       End If 
  911.       SHADOUT[506,46,16,9]
  912.    End If 
  913.    '
  914.    ' >> Inc X reset <<
  915.    '
  916.    If MZ=20
  917.       SHADIN[540,46,16,9]
  918.       While Mouse Key>0 : Wend 
  919.       If SXG<MXG
  920.          Inc SXG
  921.          TPRINT[524,47,14,Str$(SXG)-" "]
  922.       End If 
  923.       SHADOUT[540,46,16,9]
  924.    End If 
  925.    '
  926.    ' >> Dec Y reset <<
  927.    '
  928.    If MZ=21
  929.       SHADIN[506,57,16,9]
  930.       While Mouse Key>0 : Wend 
  931.       If SYG>1
  932.          Dec SYG
  933.          TPRINT[524,58,14,Str$(SYG)-" "]
  934.       End If 
  935.       SHADOUT[506,57,16,9]
  936.    End If 
  937.    '
  938.    ' >> Inc Y reset <<
  939.    '
  940.    If MZ=22
  941.       SHADIN[540,57,16,9]
  942.       While Mouse Key>0 : Wend 
  943.       If SYG<MYG
  944.          Inc SYG
  945.          TPRINT[524,58,14,Str$(SYG)-" "]
  946.       End If 
  947.       SHADOUT[540,57,16,9]
  948.    End If 
  949.    '
  950.    RET:
  951.    PANELTOP
  952.    Pop Proc
  953.    '
  954.    EH:
  955.    If Errn=84
  956.       Screen To Front 4
  957.       SHADOUT[424,57,16,9]
  958.       PANELTOP
  959.       Screen Copy 1 To 3
  960.       Screen To Front GRIDTYPE
  961.       Screen To Front 4
  962.       Screen GRIDTYPE
  963.       MESS["Disk write protected - Please un-protect and try again"]
  964.       Wait 100
  965.    Else 
  966.       MESS["ERROR!"]
  967.       Wait 100
  968.    End If 
  969.    Resume RET
  970. End Proc
  971. Procedure SVENAME
  972.    STRT:
  973.    Clear Key 
  974.    SNAME$=Fsel$("","","Choose a file name","* Check write-protection *")
  975.    If SNAME$=""
  976.       Pop Proc
  977.    End If 
  978.    If Exist(SNAME$)
  979.       MESS["File exists, replace? (Press Y or N)"]
  980.       Do 
  981.          If Key State(21)
  982.             PANELTOP
  983.             Exit 
  984.          End If 
  985.          If Key State(54)
  986.             PANELTOP
  987.             Goto STRT
  988.          End If 
  989.       Loop 
  990.    End If 
  991. End Proc
  992. Procedure EHANDLER
  993.    If Errn=32
  994.       MESS["IFF image not of required dimensions"]
  995.       Wait 100
  996.       PANELTOP
  997.       Resume Label 
  998.       Pop Proc
  999.    End If 
  1000. End Proc