home *** CD-ROM | disk | FTP | other *** search
/ AMOS PD CD / amospdcd.iso / 301-325 / apd323 / spritegrabber.amos / spritegrabber.amosSourceCode < prev   
AMOS Source Code  |  1978-02-21  |  8KB  |  348 lines
  1. '----------------------------- 
  2. '-    Bob Grabber Utility    -   
  3. '-    by Aaron Fothergill    - 
  4. '-(somewhat changed by DEATH)- 
  5. '- (c) Mandarin / Jawx 1990  - 
  6. '----------------------------- 
  7. '
  8. 'Here's a list of the changes I made:
  9. '
  10. ' 1. The menu looks better (...that's my opinion)
  11. '    and take's up almost the same memory. 
  12. ' 2. I included a counter which always indicates the total number of sprites.
  13. ' 3. I added three extra options: AJUST MOUSE, DEL and EXTRAMEMORY.
  14. ' 4. Moving from sprite 1 to sprite 103 goes faster when you press the right 
  15. '    mouse button. 
  16. ' 5. I included a small error-handler. 
  17. ' 6. To quit you have to press both mouse buttons, to avoid mistakes.
  18. ' 7. Now you pick up a brush exactly at the edges. 
  19. ' 8. I chose a more suitable mouse-pointer.
  20. ' 9. Especially for people with low memory (or people who enjoy looking at the 
  21. '    huge amount of memory they have) I made a memory-counter. 
  22. '10. Before every label or procedure-call off something I added, I made a
  23. '    small 'Rem'-statement, so it's easier for you to understand the strange 
  24. '    programming I've been doing to your program.
  25. '
  26. 'Something that off course hasn't changed, is the author, Aaron Fothergill,  
  27. '(you probably) who programmed the tricky parts. I really don't mind if you
  28. 'cut out all the REMarks, if you're ever going to use it. (Which I hope you
  29. 'will.)
  30. '
  31. Rem :I built in an Error-handler, just in case.  
  32. On Error Goto REPAIR_FAULT
  33. FAULT
  34. Y=0
  35. YO=-1
  36. SCH=200
  37. SCW=320
  38. Rem :I made it look a bit nicer, graphically.
  39. Unpack 6 To 1
  40. Rem :A nice pointer
  41. Colour 17,$F
  42. Colour 18,$77F
  43. Colour 19,0
  44. Rem :If you hear a sound, it's more obvious you pressed a button.  
  45. SOUND
  46. Gosub GTSCRN
  47. SX=0 : SY=0 : SXO=-1 : XO=-1
  48. Screen To Front 1
  49. STZONES
  50. SNUM=1
  51. SHWSNUM[SNUM]
  52. Do 
  53.    K=Mouse Key : Z=Mouse Zone
  54.    If K=0 Then TICK=0
  55.    X=X Screen(X Mouse)
  56.    If X/160<>XO
  57.       XO=X/160
  58.       SHWSPRT[Y,SNUM,X]
  59.    End If 
  60.    If K>0 and Z>0
  61.       Play 10,0
  62.       On Z Gosub DWN,UP,CUT,GTSCRN,GTSPR,SVSPR,DEL,AJUST,QUIT,EXTRAMEM
  63.       SHWSPRT[Y,SNUM,X]
  64.    End If 
  65.    If Y<>YO
  66.       YO=Y
  67.       DISPBAR[Y]
  68.       SHWSPRT[Y,SNUM,X]
  69.    End If 
  70.    If SY<>SYO or SX<>SXO
  71.       DISPSCRN[SX,SY]
  72.       SXO=SX : SYO=SY
  73.    End If 
  74.    A$=Inkey$
  75.    If A$=Chr$(30)
  76.       If Y>0
  77.          Add Y,-4
  78.       Else 
  79.          If SY>0
  80.             Add SY,-4
  81.          End If 
  82.       End If 
  83.    End If 
  84.    If A$=Chr$(31)
  85.       If Y<SCH-24
  86.          Add Y,4
  87.       Else 
  88.          If SY<Max(0,SCY-SCH)
  89.             Add SY,4
  90.          End If 
  91.       End If 
  92.    End If 
  93.    If A$=Chr$(28)
  94.       If SX>0
  95.          Add SX,-16
  96.       End If 
  97.    End If 
  98.    If A$=Chr$(29)
  99.       If SX<Max(0,SCX-SCW*REZ)
  100.          Add SX,16
  101.       End If 
  102.    End If 
  103. Loop 
  104. Rem :Now you have to press both mouse buttons at the same time to quit.
  105. Rem :This way you will avoid quitting accidentely.   
  106. QUIT:
  107. If Mouse Key=3 Then Boom : End 
  108. Return 
  109. Rem :The limits of the mouse usualy dont't fit the picture.
  110. Rem :Pressing AJUST will fix this.   
  111. AJUST:
  112. SCREN=Screen
  113. Screen 0
  114. Limit Mouse 
  115. Screen SCREN
  116. Return 
  117. REPAIR_FAULT:
  118. SCREN=Screen
  119. Screen To Front 2
  120. Screen Show 2
  121. Screen 2
  122. Locate 2,1 : Print "Error in program. AMOS error code:";Errn;"."
  123. Locate 2,2 : Print "     LEFT=Continue (risk of a software failure)      RIGHT=Quit program     "
  124. Do 
  125.    If Mouse Key=1 Then Screen Hide 2 : Screen SCREN : Resume Next 
  126.    If Mouse Key=2 Then Edit 
  127. Loop 
  128. Rem :This clears all sprites 
  129. DEL:
  130. If K=3
  131.    Boom 
  132.    Erase 1
  133.    SNUM=1
  134.    SHWSNUM[SNUM]
  135.    SHWMEM
  136.    Wait 37
  137. End If 
  138. Return 
  139. Rem :This deletes one sprite 
  140. EXTRAMEM:
  141. Close Editor 
  142. Close Workbench 
  143. Erase 6
  144. SHWMEM
  145. Return 
  146. GTSPR:
  147. SNUM=1
  148. F$=""
  149. F$=Fsel$("*.ABK","","Load a Sprite Bank")
  150. If F$<>""
  151.    F2$=Right$(F$,4)
  152.    If Upper$(F2$)=".ABK"
  153.       Erase 1
  154.       Load F$
  155.       A$="" : A=0 : Repeat : A$=A$+Chr$(Peek(Start(1)-8+A)) : Inc A : Until A=8
  156.       If A$<>"Sprites "
  157.          F$=""
  158.       Else 
  159.          Screen 0
  160.          Get Sprite Palette 
  161.          Screen 1
  162.       End If 
  163.    Else 
  164.       F$=""
  165.    End If 
  166. End If 
  167. Return 
  168. SVSPR:
  169. F$=Fsel$("","","Save the Sprite Bank As:")
  170. If F$<>""
  171.    F2$=Right$(F$,4)
  172.    If Upper$(F2$)=".ABK"
  173.       Save F$,1
  174.    End If 
  175. End If 
  176. Return 
  177. Rem :I replaced X2 and Y2 by X2+1 and Y2+1 to include the edges when grabbing a bob
  178. CUT:
  179. Change Mouse 2
  180. If Fast Free+Chip Free>10000
  181.    Bob 1,999,1,1
  182.    Update 
  183.    Update Off 
  184.    Screen To Front 0
  185.    Screen 0
  186.    Get Block 1,0,0,SCX,SCY
  187.    X2O=-1 : Y2O=-1
  188.    While Mouse Key<>0 : Wend : Wait 5
  189.    While Mouse Key=0 : Wend : X1=X Screen(X Mouse) : Y1=Y Screen(Y Mouse)
  190.    While Mouse Key>0 : X2=X Screen(X Mouse) : Y2=Y Screen(Y Mouse)
  191.       If X2O<>X2 or Y2O<>Y2
  192.          Gosub SHWBOX : X2O=X2 : Y2O=Y2
  193.       End If 
  194.    Wend 
  195.    Gosub SHWBOX : Put Block 1,0,0
  196.    Get Bob SNUM,Max(0,X1),Max(0,Y1) To Max(0,X2+1),Max(0,Y2+1)
  197.    Update On 
  198.    Screen To Front 1 : Screen 1
  199.    Bob Off 1
  200.    Update 
  201.    Del Block 1
  202.    SHWMEM
  203. End If 
  204. Change Mouse 1
  205. Return 
  206. SHWBOX:
  207. Put Block 1,0,0
  208. Ink 1
  209. X3=Min(X1,X2) : X2=Max(X1,X2) : X1=X3
  210. Y3=Min(Y1,Y2) : Y2=Max(Y1,Y2) : Y1=Y3
  211. X2=Max(X1+1,X2) : Y2=Max(Y1+1,Y2)
  212. Gr Writing 3
  213. Box X1,Y1 To X2,Y2
  214. Gr Writing 1
  215. Return 
  216. Rem :If you press the right mouse button, the SpriteNUMber will increase or
  217. Rem :decrease by 10 (if possible)  
  218. DWN:
  219. If SNUM>1
  220.    If K=1
  221.       Dec SNUM
  222.    Else 
  223.       SNUM=SNUM-10
  224.       If SNUM<1
  225.          SNUM=1
  226.       End If 
  227.    End If 
  228.    SHWSNUM[SNUM]
  229.    While Mouse Key<>0 and TICK<1000
  230.       Inc TICK
  231.    Wend : TICK=Min(TICK,500)
  232. End If 
  233. Return 
  234. UP:
  235. If SNUM<Length(1)+1
  236.    If K=1
  237.       Inc SNUM
  238.    Else 
  239.       SNUM=SNUM+10
  240.       If SNUM>Length(1)
  241.          SNUM=Length(1)+1
  242.       End If 
  243.    End If 
  244.    SHWSNUM[SNUM]
  245.    While Mouse Key<>0 and TICK<1000
  246.       Inc TICK
  247.    Wend : TICK=Min(TICK,500)
  248. End If 
  249. Return 
  250. GTSCRN:
  251. F$=Fsel$("","","Pick a Picture !")
  252. If F$<>""
  253.    Auto View Off 
  254.    Screen Close 0
  255.    If Upper$(Right$(F$,4))=".ABK"
  256.       Load F$,5
  257.       Unpack 5 To 0
  258.       Erase 5
  259.    Else 
  260.       Load Iff F$,0
  261.    End If 
  262.    A=Screen Base+72
  263.    SCX=Deek(A+4)
  264.    SCY=Deek(A+6)
  265.    REZ=1
  266.    If Btst(Deek(A),15)
  267.       REZ=2
  268.    End If 
  269.    Screen To Front 1
  270.    Auto View On 
  271. End If 
  272. Return 
  273. Procedure DISPBAR[YPOS]
  274.    Screen Display 1,,48+YPOS,,40
  275. End Proc
  276. Procedure DISPSCRN[XPOS,YPOS]
  277.    Shared SCX,SCY
  278.    Screen Display 0,,48-YPOS,,SCY
  279.    Screen Offset 0,XPOS,0
  280. End Proc
  281. Procedure SHWSNUM[S]
  282.    L$=Mid$(Str$(Length(1)),2)
  283.    L$=Right$("00"+L$,3)
  284.    S$=Mid$(Str$(S),2)
  285.    S$=Right$("00"+S$,3)
  286.    Ink 7,0
  287.    Text 21,14,L$
  288.    Text 69,14,S$
  289.    SHWMEM
  290. End Proc
  291. Procedure STZONES
  292.    Screen 1
  293.    Reserve Zone 10
  294.    Set Zone 1,49,4 To 63,18
  295.    Set Zone 2,97,4 To 111,18
  296.    Set Zone 3,113,4 To 143,18
  297.    Set Zone 4,145,4 To 175,18
  298.    Set Zone 5,177,4 To 207,18
  299.    Set Zone 6,209,4 To 239,18
  300.    Set Zone 7,241,4 To 255,18
  301.    Set Zone 8,257,4 To 283,18
  302.    Set Zone 9,285,4 To 315,18
  303.    Set Zone 10,106,21 To 136,35
  304. End Proc
  305. Procedure SHWSPRT[YPOS,N,MX]
  306.    Screen 0
  307.    If Length(1)>=N
  308.       BX=80 : If MX<160
  309.          BX=240
  310.       End If 
  311.       BY=YPOS+50+Deek(Sprite Base(N)+8)
  312.       If YPOS>100
  313.          BY=BY-56-Deek(Sprite Base(N)+2)
  314.       End If 
  315.       Bob 1,BX,BY,N
  316.       Update 
  317.    Else 
  318.       Bob Off 1
  319.       Update 
  320.    End If 
  321.    Screen 1
  322. End Proc
  323. Procedure SOUND
  324.    Set Envel 1,0 To 8,20
  325.    Set Envel 1,1 To 8,4
  326.    Set Envel 1,2 To 25,0
  327.    Led On 
  328. End Proc
  329. Procedure FAULT
  330.    Screen Open 2,640,32,4,Hires
  331.    Curs Off 
  332.    Cls 0
  333.    Paper 0
  334.    Pen 1
  335.    Palette 0,$F00,$F77,$FFF
  336.    Ink 2,0
  337.    Box 8,4 To 632,28
  338.    Paint 1,1
  339.    Ink 1,0
  340.    Flash 2,"(000,20)(500,2)(A00,2)(F00,20)(A00,2)(500,2)"
  341.    Screen Hide 2
  342. End Proc
  343. Rem :The SHoW free MEMory counter. 
  344. Procedure SHWMEM
  345.    MEM$=Str$(Chip Free+Fast Free)-" "
  346.    MEM$=String$("0",(8-Len(MEM$)))+MEM$
  347.    Text 38,31,MEM$
  348. End Proc