home *** CD-ROM | disk | FTP | other *** search
/ Amoszine 10 / Amoszine 10 (Disk 3 of 3).adf / Amos_Procs.lha / bobchopping.amos / bobchopping.amosSourceCode < prev    next >
Encoding:
AMOS Source Code  |  1991-12-03  |  5.0 KB  |  227 lines
  1. Screen Open 0,320,200,16,Lowres
  2. Reserve As Work 15,100000
  3. Limit Mouse 
  4. Flash Off 
  5. Screen Open 0,640,75,4,Hires
  6. Curs Off 
  7. Palette $888,$FFF,$F0,$F00
  8. Paper 0
  9. Pen 1
  10. Screen Open 1,320,256,2,Lowres
  11. Curs Off 
  12. '
  13. MENUVPOS=200
  14. Screen Display 0,,MENUVPOS,,
  15. MASK=-1
  16. BLOCKWIDTH=3
  17. BLOCKHEIGHT=32
  18. MENUDRAW
  19. MENUFRONT
  20. '
  21. While WIDTH=0
  22.    SCRLOAD
  23. Wend 
  24. MAIN:
  25. Do 
  26.    INVBLOCK[XPOS,YPOS]
  27.    A$=""
  28.    While A$=""
  29.       A$=Inkey$
  30.    Wend 
  31.    INVBLOCK[XPOS,YPOS]
  32.    If A$="l" Then SCRLOAD
  33.    If A$="-" Then MENUUP
  34.    If A$="+" Then MENUDOWN
  35.    If A$="m" Then MASKTOGGLE
  36.    If A$="b" Then BLOCKSIZEGET
  37.    If A$="c" Then MAKECOPPERLIST
  38.    If A$="s" Then BLOCKSAVE
  39.    If A$=Cup$ Then UP
  40.    If A$=Cdown$ Then DN
  41.    If A$=Cleft$ Then LF
  42.    If A$=Cright$ Then RT
  43. Loop 
  44. '
  45. '
  46. Procedure SCRLOAD
  47.    Shared WIDTH,HEIGHT,NUMBEROFCOLOURS,NUMBEROFPLANES,XPOS,YPOS
  48.    'Shared BLOCKWIDTH,BLOCKHEIGHT 
  49.    F$=Fsel$("df1:","","Select an IFF screen to load")
  50.    While F$<>""
  51.       Load Iff F$,1
  52.       F$=""
  53.       WIDTH=Screen Width
  54.       HEIGHT=Screen Height
  55.       NUMBEROFCOLOURS=Screen Colour
  56.       NUMBEROFPLANES=0
  57.       If NUMBEROFCOLOURS=0 Then NUMBEROFPLANES=0
  58.       If NUMBEROFCOLOURS=2 Then NUMBEROFPLANES=1
  59.       If NUMBEROFCOLOURS=4 Then NUMBEROFPLANES=2
  60.       If NUMBEROFCOLOURS=8 Then NUMBEROFPLANES=3
  61.       If NUMBEROFCOLOURS=16 Then NUMBEROFPLANES=4
  62.       If NUMBEROFCOLOURS=32 Then NUMBEROFPLANES=5
  63.       If NUMBEROFCOLOURS=64 Then NUMBEROFPLANES=6
  64.       MENUDRAW
  65.       MENUFRONT
  66.       XPOS=0
  67.       YPOS=0
  68.    Wend 
  69. End Proc
  70. '
  71. Procedure MENUFRONT
  72.    Screen 0
  73.    Screen To Front 0
  74. End Proc
  75. '
  76. Procedure MENUBACK
  77.    Screen 1
  78.    Screen To Front 1
  79. End Proc
  80. '
  81. Procedure MENUUP
  82.    Shared MENUVPOS
  83.    If MENUVPOS>-10 Then MENUVPOS=MENUVPOS-8
  84.    Screen Display 0,,MENUVPOS,,
  85. End Proc
  86. '
  87. Procedure MENUDOWN
  88.    Shared MENUVPOS
  89.    If MENUVPOS<300 Then MENUVPOS=MENUVPOS+8
  90.    Screen Display 0,,MENUVPOS,,
  91. End Proc
  92. '
  93. Procedure MENUDRAW
  94.    Shared WIDTH,HEIGHT,NUMBEROFCOLOURS,NUMBEROFPLANES,MASK,BLOCKWIDTH,BLOCKHEIGHT
  95.    MENUFRONT
  96.    Cls 0
  97.    Home 
  98.    Print "<L>oad IFF"
  99.    Print "<M>asK ";
  100.    If MASK Then Print "On" Else Print "Off"
  101.    Print "<B>lock size  (Current =";BLOCKWIDTH;" words x";BLOCKHEIGHT;" lines)"
  102.    Print "<S>ave block (as raw data)"
  103.    Print "Generate <C>opperlist"
  104.    Print "Modulo=";(WIDTH/8)-(2*BLOCKWIDTH)
  105.    Print "number of bitplanes=";NUMBEROFPLANES;""
  106.    Print "ScreenWidth=";WIDTH;"  ScreenHeight=";HEIGHT;"  Max.NumberofColours=";NUMBEROFCOLOURS;""
  107. End Proc
  108. '
  109. Procedure MASKTOGGLE
  110.    Shared MASK
  111.    If MASK=True Then MASK=False Else MASK=True
  112.    MENUDRAW
  113. End Proc
  114. '
  115. Procedure BLOCKSIZEGET
  116.    Shared BLOCKWIDTH,BLOCKHEIGHT,XPOS,YPOS,WIDTH,HEIGHT
  117.    MENUFRONT
  118.    Cls 
  119.    Print 
  120.    Input "Enter block width (words): ";BLOCKWIDTH
  121.    If BLOCKWIDTH<=0 Then BLOCKWIDTH=1
  122.    If BLOCKWIDTH>WIDTH/16 Then BLOCKWIDTH=WIDTH/16
  123.    Input "Enter block height (lines): ";BLOCKHEIGHT
  124.    If BLOCKHEIGHT<=0 Then BLOCKHEIGHT=16
  125.    If BLOCKHEIGHT>HEIGHT Then BLOCKHEIGHT=HEIGHT
  126.    MENUDRAW
  127.    XPOS=0
  128.    YPOS=0
  129. End Proc
  130. '
  131. Procedure INVBLOCK[X,Y]
  132.    Shared BLOCKWIDTH,BLOCKHEIGHT
  133.    Screen 1
  134.    Gr Writing 2
  135.    Bar X*BLOCKWIDTH*16,Y*BLOCKHEIGHT To((X+1)*BLOCKWIDTH*16)-1,((Y+1)*BLOCKHEIGHT)-1
  136.    Screen 0
  137. End Proc
  138. '
  139. '
  140. '
  141. Procedure UP
  142.    Shared YPOS,BLOCKHEIGHT
  143.    If YPOS>0 Then YPOS=YPOS-1
  144. End Proc
  145. '
  146. Procedure DN
  147.    Shared YPOS,BLOCKHEIGHT,HEIGHT
  148.    If((YPOS+2)*BLOCKHEIGHT)-1<HEIGHT Then YPOS=YPOS+1
  149. End Proc
  150. '
  151. Procedure LF
  152.    Shared XPOS,BLOCKWIDTH
  153.    If XPOS>0 Then XPOS=XPOS-1
  154. End Proc
  155. '
  156. Procedure RT
  157.    Shared XPOS,BLOCKWIDTH,WIDTH
  158.    If((XPOS+2)*BLOCKWIDTH*16)-1<WIDTH Then XPOS=XPOS+1
  159. End Proc
  160. '  
  161. '
  162. Procedure MAKECOPPERLIST
  163.    Shared NUMBEROFCOLOURS
  164.    F$=Fsel$("df1:","","Save copper source")
  165.    If F$<>""
  166.       Open Out 1,F$
  167.       Print #1,Chr$(10);
  168.       For I=0 To NUMBEROFCOLOURS-1
  169.          I$=Str$(I)-" "
  170.          If Len(I$)=1
  171.             I$="0"+I$
  172.          End If 
  173.          Screen 1
  174.          A$=Chr$(9)+Chr$(9)+"dc.w"+Chr$(9)+"COLOR"+I$+","+Hex$(Colour(I),4)+Chr$(10)
  175.          'Print Hex$(Colour(I),4) 
  176.          Print #1,A$;
  177.       Next 
  178.       Print #1,Chr$(10);
  179.       Close 1
  180.    End If 
  181. End Proc
  182. '
  183. '
  184. '
  185. Procedure BLOCKSAVE
  186.    Shared NUMBEROFPLANES,XPOS,YPOS,BLOCKWIDTH,BLOCKHEIGHT,WIDTH,HEIGHT,MASK
  187.    '
  188.    Screen 1
  189.    PTR=0
  190.    X=XPOS*BLOCKWIDTH*2
  191.    Y=YPOS*BLOCKHEIGHT
  192.    BLOCKSIZE=BLOCKWIDTH*2*BLOCKHEIGHT
  193.    For PLANE=0 To NUMBEROFPLANES-1
  194.       PLANEADDR=Phybase(PLANE)
  195.       For H=Y To Y+BLOCKHEIGHT-1
  196.          For W=X To X+(BLOCKWIDTH*2)-1
  197.             A=Peek(PLANEADDR+(H*WIDTH/8)+W)
  198.             Poke Start(15)+PTR,A
  199.             PTR=PTR+1
  200.          Next 
  201.       Next 
  202.    Next 
  203.    '
  204.    If MASK=True
  205.       For W=0 To BLOCKSIZE-1
  206.          A=0
  207.          For PLANE=0 To NUMBEROFPLANES-1
  208.             A=A or Peek(Start(15)+(BLOCKSIZE*PLANE)+W)
  209.          Next 
  210.          Poke Start(15)+PTR,A
  211.          PTR=PTR+1
  212.       Next 
  213.    End If 
  214.    '
  215.    F$=Fsel$("df1:","","Save raw data")
  216.    If F$<>""
  217.       Bsave F$,Start(15) To Start(15)+PTR
  218.    End If 
  219.    Screen 0
  220.    Cls 0
  221.    Print "Block saved in raw format"
  222.    Print "Blocksize =";BLOCKSIZE;" bytes per bitplane (also mask)"
  223.    Print 
  224.    Print "Press a key..."
  225.    Wait Key 
  226.    MENUDRAW
  227. End Proc