home *** CD-ROM | disk | FTP | other *** search
/ No Fragments Archive 10: Diskmags / nf_archive_10.iso / MAGS / STMAGAZIN / STMAGAZIN.MSA / UTILS / MOVE_IT / MOVE_IT.LST < prev    next >
File List  |  1986-02-06  |  12KB  |  696 lines
  1. ' MOVE IT! - 01/08/88
  2. ' U. Kreisel, GFA_BAS 2.02
  3. ' (c) Markt&Technik, 8013 Haar
  4. '
  5. Clear
  6. @Init
  7. @Men_leiste
  8. Menu Leiste$()
  9. On Menu  Gosub Menue
  10. Do
  11.   On Menu
  12. Loop
  13. Procedure Menue
  14.   S%=Menu(0)
  15.   On S% Gosub Info
  16.   On S%-10 Gosub B_ed,An,Dy,Film
  17.   On S%-16 Gosub Aus
  18.   Menu Off
  19. Return
  20. Procedure Info
  21.   Alert 1,"MOVE IT!",1,"OK",Kk%
  22. Return
  23. Procedure Init
  24.   Dim Gg(100),Hs(100)
  25.   Dim Z$(100),F$(14)
  26.   M=99
  27.   Ctr=1
  28.   U=18
  29.   I=90
  30.   O=305
  31.   P=263
  32.   Long=O-U
  33.   Fa%=2
  34.   Lo%=4
  35.   G%=1
  36.   V%=314
  37.   @Sts
  38.   St$=G$
  39.   @Sts
  40.   T$=G$
  41.   For H=1 To 13
  42.     Read F$(H)
  43.   Next H
  44.   Get 95,220,210,240,Dlt$
  45.   Get U,I,O,P,Z$(0)
  46.   @Bak(1,2,4)
  47.   @Log
  48.   @Txt
  49.   @Frb
  50.   Get 10,270,300,340,Dlt$
  51. Return
  52. Procedure Sts
  53.   G$=Mki$(8)+Mki$(8)+Mki$(1)+Mki$(0)+Mki$(1)
  54.   For I%=1 To 16
  55.     Read Vorn
  56.     G$=G$+Mki$(0)+Mki$(Vorn)
  57.   Next I%
  58. Return
  59. Procedure B_ed
  60.   Sn=0
  61.   @Bak(1,2,4)
  62.   @Txt
  63.   @Cap
  64.   Jump=0
  65.   Put 334,32,Logo$
  66.   Pbox U-1,I-1,O+1,P+1
  67.   Pbox U+V%-1,I-1,O+V%+1,P+1
  68.   Put U+V%,I,Z$(0)
  69.   Graphmode 2
  70.   Deftext 1,0,0,13
  71.   For H=1 To 4
  72.     Text 332,270+H*16,286,F$(H)
  73.   Next H
  74.   Put U,I,Z$(Rm)
  75.   @Report
  76.   Repeat
  77.     @Count
  78.   Until Sn=3
  79. Return
  80. Procedure Count
  81.   Mouse X,Y,K
  82.   If K=1
  83.     If X>U-1 And X<O+1 And Y>I-1 And Y<P+1
  84.       Plot X,Y
  85.     Endif
  86.     If Y>350
  87.       Jump=Abs(Int((20-X)/60))
  88.     Endif
  89.   Endif
  90.   Dt$=Inkey$
  91.   If Jump=0 And Dt$<>""
  92.     For Kees=59 To 69
  93.       Inc Jump
  94.       If Dt$=Chr$(0)+Chr$(Kees)
  95.         Kees=69
  96.       Endif
  97.     Next Kees
  98.   Endif
  99.   If Jump>0 And Jump<11
  100.     @Abk
  101.     On Jump Gosub F1,F2,F3,F4,F5,F6,F7,An,Dy,F10
  102.     @Report
  103.     @Abk
  104.   Endif
  105.   Jump=0
  106.   If Dt$>"0" Or Dt$<=Chr$(128)
  107.     @Det
  108.   Endif
  109. Return
  110. Procedure Abk
  111.   If Jump>0 And Jump<11
  112.     @Inv(20+(Jump-1)*60,350,20+(Jump)*60,382)
  113.   Endif
  114. Return
  115. Procedure Det
  116.   If Dt$=Chr$(127)
  117.     Put U,I,Z$(0)
  118.   Endif
  119.   If X>U And X<O And Y>I And Y<P
  120.     If Dt$="1"
  121.       Deffill 1,2,2
  122.       Fill X,Y
  123.     Endif
  124.     If Dt$="2"
  125.       Deffill 1,2,4
  126.       Fill X,Y
  127.     Endif
  128.   Endif
  129. Return
  130. Procedure F1
  131.   @Abk
  132.   @Frb
  133.   Sn=3
  134. Return
  135. Procedure F2
  136.   Check$=""
  137.   Graphmode 2
  138.   Deftext 1,0,0,13
  139.   For H=5 To 8
  140.     Text U,206+H*16,250,F$(H)
  141.   Next H
  142.   Do
  143.     K$=Inkey$
  144.     Exit If K$=Chr$(13) Or Rm<=0
  145.     E%=Asc(K$)
  146.     On E%-41 Gosub In,Pl,Dy,Dy,K
  147.     @Report
  148.     @Cap
  149.     Put U,I,Z$(G%)
  150.     Print At(37,18);
  151.     @Use(G%)
  152.   Loop
  153.   Put 18,268,Dlt$
  154. Return
  155. Procedure In
  156.   Inc Ctr
  157.   Inc Rm
  158.   For Sh=Ctr To G% Step -1
  159.     Z$(Sh)=Z$(Sh-1)
  160.   Next Sh
  161.   Get U+314,I,O+314,P,Ab$
  162.   @F6
  163.   Get U,I,O,P,Z$(G%)
  164. Return
  165. Procedure Pl
  166.   If G%=1
  167.     Rz=0
  168.   Endif
  169.   If G%=Rm
  170.     Rz=1
  171.   Endif
  172.   If Rz=1
  173.     G%=1
  174.   Else
  175.     Inc G%
  176.   Endif
  177. Return
  178. Procedure K
  179.   Z$(G%)=""
  180.   For Ix=G% To Rm
  181.     Z$(Ix)=Z$(Ix+1)
  182.   Next Ix
  183.   Dec Ctr
  184.   Dec Rm
  185.   Dec G%
  186.   If G%<=0
  187.     G%=1
  188.   Endif
  189. Return
  190. Procedure F3
  191.   Pause U
  192.   Graphmode 3
  193.   While Mousek=0
  194.   Wend
  195.   Mouse X%,Y%,T%
  196.   Do
  197.     Mouse X1%,Y1%,T%
  198.     Box X%,Y%,X1%,Y1%
  199.     Box X%,Y%,X1%,Y1%
  200.     Exit If T%=0
  201.   Loop
  202.   Get X%,Y%,X1%,Y1%,Cp$
  203.   Le=Abs(X1%-X%)
  204.   Ht=Abs(Y1%-Y%)
  205.   Do
  206.     Mouse X,Y,K
  207.     Vsync
  208.     Box X-Le,Y-Ht,X,Y
  209.     Box X-Le,Y-Ht,X,Y
  210.     If K=1 And X-Le>U-1 And X-Le<O+1-Le And (Y-Ht)>I-1 And (Y-Ht)<P+1-Ht
  211.       Put X-Le,(Y-Ht),Cp$,3
  212.     Endif
  213.     Exit If K=2
  214.   Loop
  215.   Graphmode 1
  216. Return
  217. Procedure F4
  218.   @Lad
  219.   If Exist(Mov$)
  220.     Open "I",#1,Mov$
  221.     Ab$=Space$(Lof(#1))
  222.     Bget #1,Varptr(Ab$),Lof(#1)
  223.     Close #1
  224.     If V%=314
  225.       Put U+V%,I,Ab$
  226.     Endif
  227.   Else
  228.     Out 2,7
  229.   Endif
  230. Return
  231. Procedure F5
  232.   Local Pam$
  233.   @Lad
  234.   If Mov$>"" And Mov$>"\"
  235.     Get U,I,O,P,Pam$
  236.     Bsave Mov$,Varptr(Pam$),Len(Pam$)
  237.     @Dis("BILD GESPEICHERT.")
  238.     Pause 50
  239.   Endif
  240. Return
  241. Procedure Lad
  242.   Dt$=""
  243.   Repeat
  244.   Until Mousek=0
  245.   Fileselect "\*.MOV","",Mov$
  246. Return
  247. Procedure F6
  248.   Put U,I,Ab$
  249. Return
  250. Procedure F7
  251.   Get U,I,O,P,Ab$
  252.   Put U+V%,I,Ab$
  253. Return
  254. Procedure F10
  255.   If Rm<M
  256.     If Cap%=<0
  257.       Alert 3,"RAM voll.|RAM löschen?|",2,"LÖSCHE|WEITER",D%
  258.       If D%=1
  259.         @Pic
  260.         Goto Ade
  261.       Else
  262.         Goto Ade
  263.       Endif
  264.     Endif
  265.     Inc Rm
  266.     Inc Ctr
  267.     Get U,I,O,P,Z$(Rm)
  268.     Hs(Rm)=2
  269.     Gg(Rm)=0
  270.     Ade:
  271.     @Cap
  272.     Pause 10
  273.   Endif
  274. Return
  275. Procedure An
  276.   If Rm>0
  277.     @Bak(1,2,4)
  278.     @Txx
  279.     @Spe
  280.     @Bak(1,Fa%,Lo%)
  281.     For Yx=1 To Rm
  282.       If Fa%=2 And Not Even(Hs(Yx))
  283.         Inc Hs(Yx)
  284.       Endif
  285.     Next Yx
  286.     @Dis("[*] <- -> [+][-] auf/ab")
  287.     Sget S$
  288.     Pos=591-Long
  289.     Pop=1
  290.     Repeat
  291.       On Break Gosub Ende
  292.       Mem%=Fre(Xt)
  293.       Reserve 2000
  294.       Ad=Gemdos(&H48,L:32768)
  295.       Bd=Xbios(&H2)
  296.       A=Xbios(&H5,L:Ad,L:Bd,-1)
  297.       Cls
  298.       Repeat
  299.         A=Xbios(&H5,L:Ad,L:Bd,-1)
  300.         @Mover
  301.         A=Xbios(&H5,L:Bd,L:Ad,-1)
  302.         @Mover
  303.         Bew$=Inkey$
  304.         If Bew$>Chr$(41)
  305.           If Bew$="*"
  306.             If Rl=1
  307.               Rl=2
  308.             Else
  309.               Rl=1
  310.             Endif
  311.           Endif
  312.           If Bew$="+"
  313.             Sub Hi,2
  314.           Endif
  315.           If Bew$="-"
  316.             Add Hi,2
  317.           Endif
  318.         Endif
  319.       Until Bew$>Chr$(64)
  320.       @Ende
  321.       Sn=3
  322.     Until Sn=3
  323.   Endif
  324. Return
  325. Procedure Mover
  326.   Sput S$
  327.   If Rl=1
  328.     Pos=Pos+Hs(Pop)
  329.   Else
  330.     Pos=Pos-Hs(Pop)
  331.   Endif
  332.   Put Pos,I+Hi,Z$(Pop)
  333.   Pause Gg(Pop)
  334.   If Pop=Rm
  335.     Pop=0
  336.   Endif
  337.   Inc Pop
  338.   If Pos<=-Long Or Pos=>640
  339.     If Rl=1
  340.       Pos=-Long+1
  341.     Else
  342.       Pos=640
  343.     Endif
  344.   Endif
  345. Return
  346. Procedure Film
  347.   V%=0
  348.   @Dis("ERSTES BILD?")
  349.   Was:
  350.   @F4
  351.   If Right$(Mov$,4)=".MOV"
  352.     If K%<>1
  353.       @Pic
  354.     Endif
  355.     Inc Rm
  356.     Inc Ctr
  357.     Z$(Rm)=Ab$
  358.     Ab$=""
  359.     Hs(Rm)=2
  360.     Gg(Rm)=0
  361.     @Cap
  362.     @Parser
  363.     @Dis(Path$+Chr$(It)+File$)
  364.     Pause 30
  365.     Do
  366.       Exit If It=>90 Or It=57 Or Cap%<=0
  367.       Inc It
  368.       Dfil$=Path$+Chr$(It)+File$
  369.       Exit If Not Exist(Dfil$)
  370.       @Dis(Dfil$)
  371.       Open "I",#1,Dfil$
  372.       Inc Rm
  373.       Inc Ctr
  374.       Z$(Rm)=Space$(Lof(#1))
  375.       Bget #1,Varptr(Z$(Rm)),Lof(#1)
  376.       Hs(Rm)=2
  377.       Gg(Rm)=0
  378.       @Cap
  379.       Close #1
  380.     Loop
  381.     Alert 2,"Weitere Bilder laden?",2,"JA|NEIN",K%
  382.     If K%=1
  383.       Goto Was
  384.     Else
  385.       @Dis("ANIMATION WÄHLEN.")
  386.     Endif
  387.   Endif
  388.   V%=314
  389. Return
  390. Procedure Parser
  391.   N%=5
  392.   If Instr(Mov$,"\")=0
  393.     Mov$="\"+Mov$
  394.   Endif
  395.   While Left$(Right$(Mov$,N%))<>"\"
  396.     Inc N%
  397.   Wend
  398.   Path$=Left$(Mov$,Len(Mov$)-N%+1)
  399.   File$=Right$(Mov$,N%-2)
  400.   It=Asc(Left$(Right$(Mov$,N%-1)))
  401. Return
  402. Procedure Pic
  403.   For Q=1 To M
  404.     Z$(Q)=""
  405.   Next Q
  406.   S$=""
  407.   Rm=0
  408.   Ctr=1
  409.   @Cap
  410. Return
  411. Procedure Dis(Disp$)
  412.   Print Chr$(27);"p";
  413.   Wt=Abs((Len(Disp$)+2)-35)
  414.   Print At(3,4);Spc(2);Disp$;Spc(Wt);
  415.   Print Chr$(27);"q";
  416. Return
  417. Procedure Frb
  418.   Graphmode 2
  419.   Deffill 1,2,1
  420.   Pbox 20,350,620,382
  421.   Graphmode 1
  422. Return
  423. Procedure Spe
  424.   @Zeig
  425.   Do
  426.     If Mousek<>0
  427.       If Mousey>350
  428.         Jump=Abs(Int((20-Mousex)/60))
  429.         @Abk
  430.         On Jump Gosub Farbe,Pas,Pixel,Re
  431.         @Abk
  432.         If Mousex>259
  433.           Goto Raus
  434.         Endif
  435.       Endif
  436.       If Mousex>30 And Mousex<=626
  437.         Ys=Int(Mousey/16)+1
  438.         Offset=Int(Ys/6.2)
  439.         Ex=Int(Mousex/24)+Offset*25
  440.         Key=Mousek
  441.         @Where(Key)
  442.       Endif
  443.     Endif
  444.     Exit If Inkey$=Chr$(13)
  445.   Loop
  446.   Raus:
  447.   Jump=0
  448. Return
  449. Procedure Zeig
  450.   Za=1
  451.   L=4
  452.   Pct=0
  453.   For Vals=5 To Rm*3+10 Step 3
  454.     Print Chr$(27);"p"
  455.     Print At(Vals,L-1);
  456.     @Use(Pct)
  457.     Print Chr$(27);"q"
  458.     Print At(Vals,L+1);
  459.     @Use(Hs(Za))
  460.     Print At(Vals,L);
  461.     @Use(Gg(Za))
  462.     Inc Za
  463.     If Za=26 Or Za=51 Or Za=76
  464.       Vals=2
  465.       L=L+5
  466.     Endif
  467.     If Za=>100 Or Za>Rm
  468.       Vals=309
  469.     Endif
  470.     Print At(3,L);"D";
  471.     Print At(3,L+1);"P";
  472.     Inc Pct
  473.   Next Vals
  474. Return
  475. Procedure Farbe
  476.   Pause 10
  477.   @Abk
  478.   If Fa%=0
  479.     Fa%=2
  480.     Lo%=4
  481.     @Ky(0,3,"GRAU ")
  482.   Else
  483.     Fa%=0
  484.     Lo%=0
  485.     @Ky(0,3,"WEISS")
  486.   Endif
  487.   @Abk
  488. Return
  489. Procedure Pas
  490.   While Pas<Rm+1 And Gg(Pas)<99
  491.     Inc Gg(Pas)
  492.     Inc Pas
  493.   Wend
  494.   @Zeig
  495.   Pas=1
  496. Return
  497. Procedure Pixel
  498.   While Px<Rm+1 And Hs(Px)<99
  499.     Inc Hs(Px)
  500.     Inc Px
  501.   Wend
  502.   @Zeig
  503.   Px=1
  504. Return
  505. Procedure Re
  506.   For Re=1 To Rm
  507.     Hs(Re)=Abs(Hs(Re)-1)
  508.     Gg(Re)=Abs(Gg(Re)-1)
  509.   Next Re
  510.   @Zeig
  511. Return
  512. Procedure Where(Kee)
  513.   If Ex<=Rm
  514.     If Ys=4 Or Ys=9 Or Ys=14 Or Ys=19
  515.       Idx=4
  516.       Vv=Gg(Ex)
  517.       @Cal(Kee,Vv)
  518.       @Zeig
  519.     Endif
  520.     If Ys=5 Or Ys=10 Or Ys=15 Or Ys=20
  521.       Idx=5
  522.       Vv=Hs(Ex)
  523.       @Cal(Kee,Vv)
  524.       @Zeig
  525.     Endif
  526.   Endif
  527. Return
  528. Procedure Cal(Kee,Vv)
  529.   If Kee=1
  530.     Inc Vv
  531.   Else
  532.     Dec Vv
  533.   Endif
  534.   If Vv>98
  535.     Vv=M
  536.   Endif
  537.   If Vv<=0
  538.     Vv=0
  539.   Endif
  540.   If Idx=4
  541.     Gg(Ex)=Vv
  542.   Endif
  543.   If Idx=5
  544.     Hs(Ex)=Vv
  545.   Endif
  546. Return
  547. Procedure Tasten
  548.   Graphmode 1
  549.   Deffill 1,0,0
  550.   X%=20
  551.   Y%=350
  552.   Lg%=60
  553.   Hh%=32
  554.   For Box=1 To 10
  555.     Pbox X%,Y%,X%+Lg%,Y%+Hh%
  556.     Add X%,Lg%
  557.   Next Box
  558. Return
  559. Procedure Ky(Ff%,Yb%,Tx$)
  560.   Deftext 1,0,0,4
  561.   Text 24+Ff%*Lg%,353+Yb%*6,Tx$
  562. Return
  563. Procedure Txt
  564.   @Tasten
  565.   @Ky(0,1,"HAUPT-")
  566.   @Ky(0,2,"MENÜ")
  567.   @Ky(0,3,"EIN")
  568.   @Ky(1,1,"BILD")
  569.   @Ky(1,2,"AUF-")
  570.   @Ky(1,3,"RUFEN")
  571.   @Ky(2,1,"CLIP-")
  572.   @Ky(2,2,"MODUS")
  573.   @Ky(2,3,"EIN")
  574.   @Ky(3,1,"BILD")
  575.   @Ky(3,2,"VON DISK")
  576.   @Ky(3,3,"LADEN")
  577.   @Ky(4,1,"BILD")
  578.   @Ky(4,2,"AUF DISK")
  579.   @Ky(4,3,"SPEI-")
  580.   @Ky(4,4,"CHERN")
  581.   @Ky(5,1,"BILD")
  582.   @Ky(5,2,"VON")
  583.   @Ky(5,3,"ABLAGE")
  584.   @Ky(5,4,"HOLEN")
  585.   @Ky(6,1,"BILD")
  586.   @Ky(6,2,"AUF")
  587.   @Ky(6,3,"ABLAGE")
  588.   @Ky(6,4,"LEGEN")
  589.   @Ky(7,1,"ANIMATION")
  590.   @Ky(9,1,"BILD")
  591.   @Ky(9,2,"IM")
  592.   @Ky(9,3,"RAM")
  593.   @Ky(9,4,"SICHERN")
  594. Return
  595. Procedure Txx
  596.   @Tasten
  597.   @Ky(0,1,"HINTER-")
  598.   @Ky(0,2,"GRUND")
  599.   @Ky(1,1,"ANZEIGE-")
  600.   @Ky(1,2,"DAUER")
  601.   @Ky(1,4,"+1")
  602.   @Ky(2,1,"PIXEL")
  603.   @Ky(2,4,"+1")
  604.   @Ky(3,1,"DAUER")
  605.   @Ky(3,2,"UND")
  606.   @Ky(3,3,"PIXEL")
  607.   @Ky(3,4,"-1")
  608.   @Ky(4,1,"START DER")
  609.   @Ky(4,2,"ANIMATION")
  610.   @Ky(4,4,"(RETURN)")
  611. Return
  612. Procedure Bak(B,N,M)
  613.   Graphmode 1
  614.   Deffill B,N,M
  615.   Pbox -1,18,640,400
  616. Return
  617. Procedure Use(Aw%)
  618.   Print Using "##",Aw%
  619. Return
  620. Procedure Inv(X1%,Y1%,X2%,Y2%)
  621.   Graphmode 3
  622.   Deffill 1,2,8
  623.   Pbox X1%+1,Y1%+1,X2%-1,Y2%-1
  624.   Graphmode 1
  625. Return
  626. Procedure Report
  627.   @Dis("Bild "+Str$(Rm)+" im RAM, in Arbeit: "+Str$(Ctr))
  628. Return
  629. Procedure Cap
  630.   Iou=Fre(Mmy%)
  631.   Cap%=Int((Iou-80000)/6270)
  632.   Print At(64,1);"Kapazität: ";
  633.   Print Using "###",Cap%
  634. Return
  635. Procedure Log
  636.   C=106
  637.   Put V%,I,Dlt$
  638.   Sprite St$,400,99
  639.   Sprite T$,416,99
  640.   Draw 391,101 To V%,101 To V%,C To 391,C
  641.   Deftext 1,17,0,13
  642.   Text 370,122,"68oooer"
  643.   Deffill 1,2,4
  644.   Fill 404,97
  645.   Fill V%,90
  646.   Graphmode 2
  647.   Deftext 1,0,0,13
  648.   Text 430,C,100,"MAGAZIN"
  649.   Text V%,94,"11/88"
  650.   Text V%,202,215,"präsentiert"
  651.   Text V%,P,215,"U. Kreisel/Markt&Technik '88"
  652.   Deftext 1,0,0,26
  653.   Text V%,240,220,"MOVE IT!"
  654.   Get V%,80,530,130,Logo$
  655. Return
  656. Procedure Dy
  657. Return
  658. Procedure Ende
  659.   A=Xbios(&H5,L:Bd,L:Bd,-1)
  660.   A=Gemdos(&H49,L:Ad)
  661.   Reserve Mem%
  662. Return
  663. Procedure Aus
  664.   Edit
  665. Return
  666. Data 8191,8192,16384,32768,32768,32895,32896
  667. Data 16480,12313,2053,63490,2,2,2,4,65535
  668. Data 65535,1,1,2,2,32894,32896,32896
  669. Data 256,256,512,512,512,512,1024,64512
  670. Data [Linke Maustaste] .. ZEICHNEN
  671. Data [Del] .. ZEICHENFLÄCHE LEEREN
  672. Data [1][2] GRAU/DUNKELGRAU FÜLLEN
  673. Data [F3] .............. CLIPMODUS
  674. Data [+] .............. Phase?
  675. Data [Enter] .......... Zurück
  676. Data [.] ....... Phase löschen
  677. Data [*] . Ablagebild einfügen
  678. Procedure Men_leiste
  679.   Dim Leiste$(20)
  680.   Restore Mendat
  681.   For I%=0 To 20
  682.     Read Leiste$(I%)
  683.     Exit If Leiste$(I%)="***"
  684.   Next I%
  685.   Leiste$(I%)=""
  686.   Leiste$(I%+1)=""
  687.   Mendat:
  688.   Data Info, MOVE IT!
  689.   Data ---------------
  690.   Data -1,-2,-3,-4,-5,-6,""
  691.   Data Funktion, Editor, Animation
  692.   Data -----------, Film,""
  693.   Data Ende, Ende ,""
  694.   Data ***
  695. Return
  696.