Otherware/Otherware_1_SB_Development.iso/amiga/misc/amoner01.dms/in.adf/Jigsaw10.AMOS/Jigsaw10.amosSourceCode

AMOS Source Code | 1978-02-21 | 11.5 KB | 436 lines

If Fast Free=0
  Load "Amoner001:jigsaw10.bank500"
Else
  Load "Amoner001:jigsaw10.bank"
  Curs Off : BANANAS
End If
Randomize Timer : Curs Off
Cls 0
Gosub MENUS
Unpack 15 To 0
WIDTH=6 : HEIGHT=4 : SIZE=48
Dim BOARD(20,12)
Global WIDTH,HEIGHT,SIZE,BOARD()
BEGIN_THE_GAME:
Menu Active(2,1)
Menu Active(2,2)
Menu Active(2,3)
Rem *************************************
Rem * Pick Picture and Number of Pieces *
Rem *************************************
Do
  If Choice
    If Choice(1)=2
      If Choice(2)=1
        PICKIFF
      End If
      If Choice(2)=2 and Choice(3)=1
        WIDTH=5 : HEIGHT=3 : SIZE=64 : Gosub ACTIVE : Menu Inactive(2,2,1)
      End If
      If Choice(2)=2 and Choice(3)=2
        WIDTH=6 : HEIGHT=4 : SIZE=48 : Gosub ACTIVE : Menu Inactive(2,2,2)
      End If
      If Choice(2)=2 and Choice(3)=3
        WIDTH=10 : HEIGHT=6 : SIZE=32 : Gosub ACTIVE : Menu Inactive(2,2,3)
      End If
      If Choice(2)=2 and Choice(3)=4
        WIDTH=20 : HEIGHT=12 : SIZE=16 : Gosub ACTIVE : Menu Inactive(2,2,4)
      End If
      If Choice(2)=3
        Goto MAIN
      End If
      If Choice(2)=4
        QUIT
      End If
    End If
      If Choice(1)=1 and Choice(2)=1
         ABOUT_MUSIC
      End If
      If Choice(1)=1 and Choice(2)=2
         ABOUT_BARBARIAN_MINDS
      End If
  End If
Loop
Rem ****************
Rem * Main Section *
Rem ****************
MAIN:
  BUILD_BLOCKS
  SUFFLE
  PLACE_MIX_BOARD
  PLAI
  I_WIN
  Goto BEGIN_THE_GAME
Rem *****************************
Rem * Set Up Menus and Defaults *
Rem *****************************
MENUS:
  Menu$(1)=" About "
  Menu$(2)=" Options "
  Menu$(1,1)="About Music  "
  Menu$(1,2)="About Barbarian Minds"
  Menu$(2,1)="Pick Iff From Disk"
  Menu$(2,2)="Amount of Pieces  "
  Menu$(2,3)="Play              "
  Menu$(2,4)="Quit              "
  Menu$(2,2,1)="15   "
  Menu$(2,2,2)="24   "
  Menu$(2,2,3)="60   "
  Menu$(2,2,4)="240  "
  Menu Inactive(2,2,2)
  Menu On
Return
Rem *************************************
Rem * Activate of Number of Pieces Menu *
Rem *************************************
ACTIVE:
  Menu Active(2,2,1)
  Menu Active(2,2,2)
  Menu Active(2,2,3)
  Menu Active(2,2,4)
Return
Procedure PICKIFF
Menu Active(2,3)
FILENAME$=Fsel$("*.iff","","Select an Iff picture")
Rem
Rem Does the file exists???
Rem
If Exist(FILENAME$)=0 Then FILENAME$=""
Rem
Rem * Well, have the player really selected an iff pic??? *
Rem
If FILENAME$="" Then Goto NO_IFF
Load Iff FILENAME$,0
NO_IFF:
Rem
Rem * If screen size is diffrent then 320x200 *
Rem * Don't allow the play option.            *
Rem
  If Screen Width<>320 or Screen Height<>200 Then Menu Inactive(2,3)
End Proc
Procedure QUIT
  Default
  Run "Amoner001:Start.Amos"
End Proc
Procedure BUILD_BLOCKS
Rem *******************************************************
Rem * This procedure sets the board face into board() and *
Rem * picks up the blocks into memory.                    *
Rem *******************************************************
  For Y=1 To HEIGHT
    For X=1 To WIDTH
      BOARD(X,Y)=((Y-1)*WIDTH)+X
      XC=SIZE*(X-1) : YC=(Y-1)*SIZE
      PIECE=((Y-1)*WIDTH)+X
      Get Block PIECE,XC,YC,SIZE,SIZE
    Next X
  Next Y
Rem
Rem * Limiting the mouse, and inactving menus... *
Rem
  Limit Mouse X Hard(0),Y Hard(0) To X Hard(WIDTH*SIZE)-1,Y Hard(HEIGHT*SIZE)-1
  Menu Inactive(2,1)
  Menu Inactive(2,2)
  Menu Inactive(2,3)
End Proc
Procedure SUFFLE
Rem ******************************
Rem * Here we suffle the board() *
Rem ******************************
  SUM=HEIGHT*WIDTH
  For X=1 To SUM*5
    X1=(Rnd(WIDTH-1))+1
    Y1=(Rnd(HEIGHT-1))+1
    X2=(Rnd(WIDTH-1))+1
    Y2=(Rnd(HEIGHT-1))+1
    Swap BOARD(X1,Y1),BOARD(X2,Y2)
  Next X
End Proc
Procedure PLACE_MIX_BOARD
Rem *********************************************************
Rem * Now it's time to draw the suffled board using board() *
Rem * and the blocks in the memory...                       *
Rem *********************************************************
  For Y=1 To HEIGHT
    For X=1 To WIDTH
      PIECE=BOARD(X,Y)
      XC=SIZE*(X-1) : YC=(Y-1)*SIZE
      Put Block PIECE,XC,YC
    Next X
  Next Y
End Proc
Procedure PLAI
Rem
Rem * init vers *
Rem
  X=1 : Y=1 : C=0 : LC=Screen Colour : T=0 : RX=0 : RY=0 : WIN=0
  WATCH_CUR:
Rem
Rem * Get the square cords of the corrent position... *
Rem * xc,yc = x and y upper left corner               *
Rem * x1c,y1c = x and y lower right corner            *
Rem
    XC=SIZE*(X-1) : YC=(Y-1)*SIZE
    X1C=(SIZE*(X-1))+(SIZE-1) : Y1C=((Y-1)*SIZE)+(SIZE-1)
    XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
Rem
Rem * XM and YM are the corrent mouse cords. *
Rem * Here we check the mouse pointer is     *
Rem * Still inside the current square        *
Rem
      While((XM=>XC) and(XM<=X1C) and(YM=>YC) and(YM<=Y1C))
Rem
Rem * Update XM and XY + draw a box around the currect square *
Rem
        XM=X Screen(X Mouse) : YM=Y Screen(Y Mouse)
        Inc C
        If C>LC Then C=0
        Ink C
        Box XC,YC To X1C,Y1C
Rem
Rem * Did someone click the mouse? *
Rem * If yes, mark the box.        *
Rem
        If Mouse Click=1 Then Gosub CLICKED_MARK
Rem
Rem * After returning from the box cliping *
Rem * The computer might find you won...   *
Rem
        If WIN=1 Then Pop Proc
Rem
Rem * And last, let's not forget the Menus... *
Rem * if is still possible to quit you know.. *
Rem
        If Choice(2)=4 Then QUIT
      Wend
Rem
Rem * Oooooops, mouse left the corect sqaure... *
Rem * Cover the square with the right block and *
Rem * Get the new cords to new current square.  *
Rem * By the way, if the square is marked, the  *
Rem * Sqaure will not be covered so the marking *
Rem * will stay...                              *
Rem
    PIECE=BOARD(X,Y)
    XC=SIZE*(X-1) : Y1C=(Y-1)*SIZE
    If Not(T=1 and X=RX and Y=RY) Then Put Block PIECE,XC,YC
    X=Int(XM/SIZE)+1 : Y=Int(YM/SIZE)+1
  Goto WATCH_CUR
Rem
Rem * Mouse Been clicked... *
Rem
  CLICKED_MARK:
  Inc T : MARKC=0
Rem
Rem * If mouse was clicked for the first time, Mark *
Rem * the clicked Square. Otherwise, swap Squares   *
Rem
  If T=2 Then Goto SWEEP
Rem
Rem * Marking Square *
Rem
  For MARK=0 To SIZE-1
      Inc MARKC
      If MARKC>LC Then MARKC=0
      Plot XC+MARK,YC+MARK,MARKC
      Plot XC+MARK,Y1C-MARK,MARKC
  Next MARK
    RX=X : RY=Y
  Return
Rem
Rem * Swaping Squares. *
Rem
  SWEEP:
    PIECE1=BOARD(X,Y) : PIECE2=BOARD(RX,RY)
    X1C=SIZE*(X-1) : Y1C=(Y-1)*SIZE
    X2C=SIZE*(RX-1) : Y2C=(RY-1)*SIZE
    Put Block PIECE1,X2C,Y2C
    Put Block PIECE2,X1C,Y1C
    T=0
    Swap BOARD(X,Y),BOARD(RX,RY)
Rem
Rem * Since squres were swaped, we need to check for win... *
Rem
  Gosub WINNING
  Return
  WINNING:
  WIN=1
  For LINE=1 To HEIGHT
    For ROW=1 To WIDTH
Rem
Rem * If board is not in Order, no win... *
Rem
      If BOARD(ROW,LINE)<>(((LINE-1)*WIDTH)+ROW) Then WIN=0
    Next ROW
  Next LINE
  Return
End Proc
Procedure I_WIN
Rem *********************
Rem * Winning Procedure *
Rem *********************
Rem
Rem * First we load the present color registers into *
Rem * The Vers c0 and c0.                            *
Rem
  C0=Colour(0)
  C1=Colour(1)
Rem
Rem * Now we load registers 0 and 1 with *
Rem * Black and White colours...         *
Rem
  Colour 0,$0
  Colour 1,$FFF
Rem
Rem * Opening window to display congrtulations massage. *
Rem
  Wind Save : Curs Off
  Wind Open 1,80,80,18,3
  Window 1 : Wait Vbl
  Paper 0 : Clw : Curs Off
  Pen 1 : Print : Print " Congratulations!"
  Repeat : Until Mouse Key
  Wind Close
  Colour 0,C0
  Colour 1,C1
End Proc
Procedure BANANAS
Rem *********************************************************
Rem * Here is a great example of how NOT to program in AMOS *
Rem * This 20 seconed introduction uses 3 320x200x32        *
Rem * screens, consuming about 500k... Sure there is some   *
Rem * easy way to cut that down, but I'm just too lazy....  *
Rem *********************************************************
  Auto View Off
  Unpack 14 To 1
  Screen Hide 1
  Auto View On
  Get Palette 1
  Screen Open 2,320,256,32,LORES
  Screen Open 0,320,256,32,LORES
  Screen 0
  Screen Show 1
  Cls 0
  Ink 6,0 : Text 92,100,"Barbarian Minds"
            Text 117,120,"Presents:"
  Double Buffer
  Music 1
  Wait 375
  Cls 0
  Get Palette 1
  For A=1 To 12
    Channel A To Bob A
    Bob A,10,0,A
  Next A
  BNUMBER=1
  For X=0 To 290 Step 99
    For Y=60 To 190 Step 34
      WIDTH=X-10
      HEIGHT=Y
      S$=Str$(WIDTH)+","+Str$(HEIGHT)+",140"
      Amal BNUMBER,"M "+S$
      Inc BNUMBER
    Next Y
  Next X
  Amal On :
  Wait 250 : Screen 2 : Wait Vbl : Get Palette 1 : Cls 0
  Wait Vbl : Screen Copy 1,0,60,300,200 To 2,0,60
  Screen To Front 2 : Screen Close 0 : Wait Vbl
  Appear 1 To 2,1,32000
  A=20
  While A>1
    Ink 0
    Bar 105,215 To 180,250
    Wait A/2
    Screen Copy 1,105,215,180,250 To 2,105,215
    Wait A
    A=A/1.1
  Wend
  Wait 400
  Cls 0 : Wait Vbl : Get Palette 1 : Wait Vbl : Ink 2,0 : Wait Vbl
  Text 60,30,"Program By Gal-on Broner"
  Text 60,70,"  Music And Iffs taken "
  Text 60,90,"From Various Pd Centers."
  Screen Copy 1,105,215,180,250 To 2,115,150
  Repeat : Until Mouse Click
  Screen Close 1 : Wait Vbl : Screen Close 2 : Wait Vbl : Default
End Proc
Procedure ABOUT_MUSIC
Rem
Rem * First we load the present color registers into *
Rem * The Vers c0 and c0.                            *
Rem
  C0=Colour(0)
  C1=Colour(1)
Rem
Rem * Now we load registers 0 and 1 with *
Rem * Black and White colours...         *
Rem
  Colour 0,$0
  Colour 1,$FFF
Rem
Rem * Opening window to display about music info. *
Rem
  Wind Save : Curs Off
  Wind Open 1,10,10,38,14
  Window 1 : Wait Vbl
  Paper 0 : Clw : Curs Off
  Pen 1 : Print
  Centre "While Most of my friends agree" : Print
  Centre "that I have reasonable programming" : Print
  Centre "technique, they seem to hold" : Print
  Centre "something against my musical taste." : Print
  Centre "Each time they hear a melody I've" : Print
  Centre "composed, they murmur something" : Print
  Centre "about eating lunch lately and" : Print
  Centre "wanting to keep it INSIDE." : Print
  Centre "Oh well :) That's why the music is" : Print
  Centre "a PD MOD I found and not my own" : Print
  Centre "creation...." : Print
  Repeat : Until Mouse Key
  Wind Close
  Colour 0,C0
  Colour 1,C1
End Proc
Procedure ABOUT_BARBARIAN_MINDS
Rem
Rem * First we load the present color registers into *
Rem * The Vers c0 and c0.                            *
Rem
  C0=Colour(0)
  C1=Colour(1)
Rem
Rem * Now we load registers 0 and 1 with *
Rem * Black and White colours...         *
Rem
  Colour 0,$0
  Colour 1,$FFF
Rem
Rem * Opening window to display about music info. *
Rem
  Wind Save : Curs Off
  Wind Open 1,10,10,38,12
  Window 1 : Wait Vbl
  Paper 0 : Clw : Curs Off
  Pen 1 : Print
  Centre "I always did like puzzles. So did" : Print
  Centre "my friend, Yuval Miinster. After" : Print
  Centre "we wrote our first serious game" : Print
  Centre "on the App*e we decided that" : Print
  Centre "amazing coders such as ourself" : Print
  Centre "needed a name (we were all young" : Print
  Centre "and foolish then). So we took the" : Print
  Centre "'B' from Broner and 'M' from" : Print
  Centre "Miinster and created Barbarian Minds." : Print
  Repeat : Until Mouse Key
  Clw
  Centre "So... if you like puzzels and you" : Print
  Centre "have a 'B' or a 'M' somewhere, and" : Print
  Centre "you can find us 20 usages for a towel" : Print
  Centre "other then covering your eyes with," : Print
  Centre "You are welcome to join us :)" : Print
  Repeat : Until Mouse Key
  Wind Close
  Colour 0,C0
  Colour 1,C1
End Proc