Casio Calculator Program Library

Program name: Colony 3 (v. 1.0) --(Back to Index)--
CTF file name: colony3.ctf
Author: Stefan Makowski, BCGSR
Date: 1999/04/26
Models: 9750, 9850, 9950

Screenshot:

[screenshot]


Description: 

   Stefan Makowski's rewrite of Colony for 9x50 calculators.
   It should be considerably faster than the original version,
   as the screen doesn't need to be redrawn at each turn.
   
   The screenshot was taken using Martin Poupe's excellent
   calculator emulator, freely available at
   http://pages.whowhere.com/computers/martin.poupe/.

* Rules * 

   See Colony.

* Internals * 

   These are the memory areas affected by this program:
   
      Mat L, Mat M, Mat N, A~Z, \theta, \r
   
   Mat M and Mat N are only used if you save your game.
   
   Unlike many programs which use matrices, you don't have to
   define any of these matrices beforehand.
   
   If you want to understand the meaning of the matrix values:
   
      Abs(Int(10Frac(Mat L[current cell] / 1*10^X) -> Y
   
   where
   
      X   Y
   
      1   number of bordering cells
      2   number of current seeds
      3   "explode bit" is set to "1" if cell is full
      4   if "1" means bordering cell on left top
      5   --- " ---   top
      6   --- " ---   right top
      7   --- " ---   right bottom
      8   --- " ---   bottom
      9   --- " ---   left bottom
     10   number of the player the cell is colonized by
   
   
   Mat L[current cell] <0 means colonized by player 2
   Mat L[current cell] >0 means colonized by player 1/empty

* Known bugs * 

   There is a problem with very big chain reactions in big
   game fields.  If there are more than 3 seeds to much in
   a 6-cell-bordering cell the number of seeds in the cell
   will be set to 0 (instead to 10) and the number of
   borderings cell to 7! That bug can't be fixed without
   completely changing of matrix system.  I think that
   situation happens too seldom to make a change neccessary.
Program source code:
Program "Colony3" 

   # intro
   
   ClrText
   Locate 1, 1, "~~~~~~~~~~~~~~~~~~~~~"
   Locate 1, 3, "~~~~~~~~~~~~~~~~~~~~~"
   Locate 8, 2, "COLONY 3"
   Locate 1, 6, "(C) Stefan Makowski , "
   Locate 4, 7, " BCGSR"
   Do
   LpWhile Not GetKey
   Norm
   BG-None
   0->\r
   0->U~W
   (-)1->Z
   ViewWindow 1, 127, 0, 63, 1, 0
   Lbl 0
   ClrText
   Locate 2, 2, "[1] New Game"
   Locate 2, 4, "[2] Restore Savegame"
   Locate 2, 6, "[3] keys"
   Do
   GetKey->A
   LpWhile A <> 72 And A <> 62 And A <> 52
   
   # show keys
   
   If A = 52
   Then ClrText
      "[A~F] And [1~6]"
      "       Select Cell"
      "[EXE]  Confirm Input"
      "[EXIT] EXIT"
      "[->]    Save Game"
      "[F6] 'Emergency Save'     (Save And Exit)"
      Do
      LpWhile Not GetKey
   IfEnd
   A = 52 => Goto 0
   
   # restore savegame
   
   If A = 62
   Then Mat M->Mat L
      1->W
      Mat N[1, 1]->U
      (-)Mat N[1, 2]->Z
      Mat N[2, 1]->V
      Dim Mat L
      List Ans[1]->G
   IfEnd
   
   # start new game
   
   If W = 0
   Then ClrText
      Locate 1, 1, "Confirm every input"
      Locate 1, 2, "with [EXE]? [1\/0]"
      Do
      GetKey->B
      LpWhile B <> 72 And B <> 71
      B = 72 => 1->U
      Do
         ClrText
         " "
         Locate 1, 1, "Size (2(-)6)"
         ?->G
      LpWhile G > 6 Or G < 2 Or G <> Int G
   IfEnd
   
   # display game field
   
   .5(64 - 10G) + 1->E
   For 1->C To G
      10(5.8 + C - 1->A
      E + 5(C - 1)->B
      C = 1 => Orange Text B - 2, A + 16, "A"
      C = 2 => Orange Text B - 2, A + 16, "B"
      C = 3 => Orange Text B - 2, A + 16, "C"
      C = 4 => Orange Text B - 2, A + 16, "D"
      C = 5 => Orange Text B - 2, A + 16, "E"
      C = 6 => Orange Text B - 2, A + 16, "F"
   Next
   
   For 1->C To G
      For 1->D To G
         10(5.8 + C - D->A
         E + 5(C - 1) + 5(D - 1)->B
         C = 1 => Orange Text B - 2, A - 4, D
         F-Line A, B + 5, A + 5, B
         F-Line A + 5, B, A + 10, B
         F-Line A + 10, B, A + 15, B + 5
         C = G => F-Line A + 15, B + 5, A + 10, B + 10
         C = G And D <> G => F-Line A + 10, B + 10, A + 5, B + 10
         D = G => F-Line A + 10, B + 10, A + 5, B + 10
         D = G => F-Line A + 5, B + 10, A, B + 5
      Next
   Next
   Green Text 1, 1, "CELL: "
   Green Text 56, 1, "WAIT..."
   Green Text 56, 1, "PLAYER: "
   
   # create matrix
   
   If W = 0
   Then .Identity G->Mat L
      For 1->H To G
         For 1->I To G
            0->F
            H > 1 => F + 1*10^9 + 1*10^6->F
            H > 1 And I > 1 => F + 1*10^9 + 1*10^5->F
            I > 1 => F + 1*10^9 + 1*10^4->F
            H < G => F + 1*10^9 + 1*10^3->F
            H < G And I < G => F + 1*10^9 + 1*10^2->F
            I < G => F + 1*10^9 + 1*10^1->F
            F->Mat L[I, H]
         Next
      Next
   IfEnd
   
   # put "seeds" if restore savegame
   
   If W = 1
   Then 9->S
      For 1->O To G
         For 1->N To G
            Goto S
            Lbl P
         Next
      Next
      0->W
   IfEnd
   
   # start of mainloop
   
   Lbl 1
   0->\th
   V + 1->V
   (-)Z->Z            ; change player (player=1=>Z=1; player=2=>Z=-1)
   Text 56, 32,  Not (Z + 1) + 1           ; display player number
   
   Lbl 2
   0->H~I
   Text 1, 21, "   "
   
   # ask for key/cell
   
   Lbl 3
   PxlOn 1, 2
   U = 0 => H <> 0 And I <> 0 => Goto 8
   Do
      GetKey->M
   LpWhile M = 0
   Frac .1M = .6 => Goto 4                 ; (A~F)
   M = 31 => Goto 8                        ; (confirm input with [exe])
   M = 72 Or M = 62 Or M = 52 Or M = 73 Or M = 63 Or M = 53 => Goto 5
                                           ; (1~6)
   M = 47 => Goto 6                        ; (exit?)
   M = 25 Or M = 29 => Goto 7              ; ("save" or "emergency save")
   Goto 3
   
   Lbl 4
   6 - (.1M - 2.6)->H
   If H > G
   Then 0->H
      Goto 3
   IfEnd
   H = 1 => Text 1, 22, "A"
   H = 2 => Text 1, 22, "B"
   H = 3 => Text 1, 22, "C"
   H = 4 => Text 1, 22, "D"
   H = 5 => Text 1, 22, "E"
   H = 6 => Text 1, 22, "F"
   Goto 3
   
   Lbl 5
   M = 72 => 1->I
   M = 62 => 2->I
   M = 52 => 3->I
   M = 73 => 4->I
   M = 63 => 5->I
   M = 53 => 6->I
   If I > G
   Then 0->I
      Goto 3
   IfEnd
   Text 1, 28, I
   Goto 3
   
   # exit?
   
   Lbl 6
   Text 50, 100, "EXIT?"
   Text 57, 100, "[F6] OK"
   PxlOn 1, 2
   Do
      GetKey->C
   LpWhile C = 0
   C = 29 => Goto Z
   Text 50, 100, "     "
   Text 57, 100, "       "
   Goto 3
   
   # save game
   
   Lbl 7
   Mat L->Mat M
   .Identity 2->Mat N
   U->Mat N[1, 1]
   Z->Mat N[1, 2]
   V->Mat N[2, 1]
   M = 29 => Goto Z
   ClrText
   "Game saved!"
   Goto 3
   
   Lbl 8
   H = 0 Or I = 0 => Goto 3           ; current cell is now Mat L[I,H]
   
   # check if cell is already colonized by other player
   
   0->\r
   Int (10Frac (Mat L[I, H] / 1*10^9)) = 0 => Goto 9
                                      ; if cell is empty procede after Lbl 9
   
   If (Mat L[I, H] < 0 And Z > 0) Or (Z < 0 And Mat L[I, H] > 0)
   Then Text 1, 20, "ALREADY"
      Text 8, 1, "COLONIZED\!"
      PxlOn 1, 2
      For 1->M To 200
      Next
      Text 8, 1, "          "
      Text 1, 20, "       "
      1->\r
   IfEnd
   
   
   Lbl 9
   \r = 1 => Goto 2
   Text 56, 32, "(-)"
   
   # put one more seed into cell
   
   Z(Abs (10Int (.1Mat L[I, H])) +  Not (Z + 1) + 1->Mat L[I, H]
   Abs (Int (10Frac (Mat L[I, H] / 1*10^9->L
   10(5.8 + H - I)->A
   E + 5(H - 1) + 5(I - 1)->B
   L = 0 => 5->J
   L = 0 Or L = 1 => 2->K
   L = 1 => 8->J
   L = 2 => 11->J
   L = 2 => 4->K
   L = 3 => 9->J
   L = 3 Or L = 4 => 7->K
   L = 4 => 6->J
   L = 5 => 3->J
   L = 5 => 5->K
   PxlOn B + K, A + J
   Z = 1 => PxlOn B + K + 1, A + J
   Z = (-)1 => PxlOn B + K, A + J + 1
   Z(Abs (Mat L[I, H]) + 1*10^8->Mat L[I, H]    ; put one more seed in matrix
   PxlOn 1, 2                               ; (I hate to have to use that!!!)
   
   # check for explosion
   
   Lbl A
   # ----------------------- ALL ONE LINE: -------------- (don't enter the \)
   Abs (Int (10Frac (Mat L[I, H] / 1*10^10))) >                             \
               (Abs (Int (10Frac (Mat L[I, H] / 1*10^9)))) => Goto T
   # ------------------------------------------------------------------------
                                        ; procede after Lbl T if no explosion
   
   Text 1, 100, "BANG\!"
   PxlOn 1, 2
   For 1->M To 100
   Next
   Text 1, 100, "     "
   PxlOn 1, 2
   H->N
   I->O
   0->T
   Goto R
   Lbl B
   # ----------------------- ALL ONE LINE: -------------- (don't enter the \)
   (L + 1) > (Abs (Int (10Frac (Mat L[I, H] / 1*10^10)))) =>                \
               (Abs (Int (10Frac (Mat L[I, H] / 1*10^10)))) - 1->L
   # ------------------------------------------------------------------------
   
   Abs (Mat L[I, H]) - (L + 1) * 10 ^ 8->Mat L[I, H]
   H->N
   I->O
   0->S
   Goto S
   Lbl C
   # ----------------------- ALL ONE LINE: -------------- (don't enter the \)
   Abs (Int (10Frac (Mat L[I, H] / 1*10^9))) = 0 =>                         \
              10Int (.1Mat L[I, H]->Mat L[I, H]
   # ------------------------------------------------------------------------
   If Abs (Int (10Frac (Mat L[I, H] / 1*10^7))) = 1
   Then H - 1->N
      I->O
      1->T
      Goto R
      Lbl D
   
   # put one more seed in every bordering cell
   
      Z(Abs (Mat L[O, N]) + 1*10^8)->Mat L[O, N]
      1->S
      Goto S
      Lbl E
   IfEnd
   If Abs (Int (10Frac (Mat L[I, H] / 1*10^6))) = 1
   Then H - 1->N
      I - 1->O
      2->T
      Goto R
      Lbl F
      Z(Abs (Mat L[O, N]) + 1*10^8)->Mat L[O, N]
      2->S
      Goto S
      Lbl G
   IfEnd
   If Abs (Int (10Frac (Mat L[I, H] / 1*10^5))) = 1
   Then H->N
      I - 1->O
      3->T
      Goto R
      Lbl H
      Z(Abs (Mat L[O, N]) + 1*10^8)->Mat L[O, N]
      3->S
      Goto S
      Lbl I
   IfEnd
   If Abs (Int (10Frac (Mat L[I, H] / 1*10^4))) = 1
   Then H + 1->N
      I->O
      4->T
      Goto R
      Lbl J
      Z(Abs (Mat L[O, N]) + 1*10^8)->Mat L[O, N]
      4->S
      Goto S
      Lbl K
   IfEnd
   If Abs (Int (10Frac (Mat L[I, H] / 1*10^3))) = 1
   Then H + 1->N
      I + 1->O
      5->T
      Goto R
      Lbl L
      Z(Abs (Mat L[O, N]) + 1*10^8)->Mat L[O, N]
      5->S
      Goto S
      Lbl M
   IfEnd
   If Abs (Int (10Frac (Mat L[I, H] / 1*10^2))) = 1
   Then H->N
      I + 1->O
      6->T
      Goto R
      Lbl N
      Z(Abs (Mat L[O, N]) + 1*10^8)->Mat L[O, N]
      6->S
      Goto S
      Lbl O
   IfEnd
   Goto T
   Lbl R
   
   # remove seeds from cell after explosion
   
   # ----------------------- ALL ONE LINE: -------------- (don't enter the \)
   T <> 0 => (Z = (-)1 And Mat L[O, N] < 0) Or                              \
                  (Z = 1 And Mat L[O, N] > 0) => Goto Q
   # ------------------------------------------------------------------------
   Abs (Int (10Frac (Mat L[O, N] / 1*10^9->C
   10(5.8 + N - O)->A
   E + 5(N - 1) + 5(O - 1)->B
   For 0->L To (C - 1)
   L = 0 => 5->J
   L = 0 Or L = 1 => 2->K
   L = 1 => 8->J
   L = 2 => 11->J
   L = 2 => 4->K
   L = 3 => 9->J
   L = 3 Or L = 4 => 7->K
   L = 4 => 6->J
   L = 5 => 3->J
   L = 5 => 5->K
   PxlOff B + K, A + J
   PxlOff B + K + 1, A + J
   PxlOff B + K, A + J + 1
   Next
   PxlOn 1, 2
   Lbl Q
   T = 0 => Goto B
   T = 1 => Goto D
   T = 2 => Goto F
   T = 3 => Goto H
   T = 4 => Goto J
   T = 5 => Goto L
   T = 6 => Goto N
   
   # put new seeds in cell after explosion
   
   Lbl S
   Abs (Int (10Frac (Mat L[O, N] / 1*10^9->M
   10(5.8 + N - O->A
   E + 5(N - 1) + 5(O - 1)->B
   W = 0 => Z(Abs (10Int (.1Mat L[O, N])) +  Not (Z + 1) + 1->Mat L[O, N]
   For 0->L To (M - 1)
   L = 0 => 5->J
   L = 0 Or L = 1 => 2->K
   L = 1 => 8->J
   L = 2 => 11->J
   L = 2 => 4->K
   L = 3 => 9->J
   L = 3 Or L = 4 => 7->K
   L = 4 => 6->J
   L = 5 => 3->J
   L = 5 => 5->K
   PxlOn B + K, A + J
   Mat L[O, N] > 0 => PxlOn B + K + 1, A + J
   Mat L[O, N] < 0 => PxlOn B + K, A + J + 1
   Next
   PxlOn 1, 2
   # ----------------------- ALL ONE LINE: -------------- (don't enter the \)
   If (Abs (Int (10Frac (Mat L[O, N] / 1*10^10)))) <=
               (Abs (Int (10Frac (Mat L[O, N] / 1*10^9))))
   # ------------------------------------------------------------------------
   Then 1 + \th->\th
      Abs (Mat L[O, N]) + 1*10^7->Mat L[O, N]
   IfEnd
   S = 0 => Goto C
   S = 1 => Goto E
   S = 2 => Goto G
   S = 3 => Goto I
   S = 4 => Goto K
   S = 5 => Goto M
   S = 6 => Goto O
   S = 9 => Goto P
   Lbl T
   
   # check if somebody has won
   
   V <= 2 => Goto X
   0->C~D
   For 1->A To G
      For 1->B To G
         Abs (Int (10Frac (Mat L[B, A] / 10->F
         F = 1 => C + 1->C
         F = 2 => D + 1->D
         C >= 1 And D >= 1 => Break
      Next
      C >= 1 And D >= 1 => Break
   Next
   C >= 1 And D >= 1 => Goto X             
   Goto Y
   
   # check for chain reactions
   
   Lbl X
   \th = 0 => Goto 1
   0->Q
   For 1->D To G
      For 1->C To G
         If Abs (Int (10Frac (Mat L[D, C] / 1*10^8))) >= 1
         Then \th - 1->\th
            1->Q                           ; "chain reaction indicator"
            (Abs (Mat L[D, C]) - 1*10^7)->Mat L[D, C]
            C->H
            D->I
            Break
         IfEnd
      Next
      Q = 1 => Break
   Next
   Q = 1 => Goto A                         ; goto "check for explosion"
   Q = 0 => Goto 1                         ; goto start of main routine
   
   # display winner
   
   Lbl Y
   Text 56, 32,  Not (Z + 1) + 1
   Text 56, 38, "WINS"
   Text 56, 100, "[EXE].."_
   
   # end of game, delete matrix, reset ViewWindow
   
   Lbl Z
   ViewWindow (-)6.3, 6.3, 1, (-)3.1, 3.1, 1
   [[0]]->Mat L
   ClrText
   Cls
   " "
   M = 29 => 8sin 156         ; if emergency exit then display "alibi"

This page was created by Tom Lynn (tom-calcs@mythic-beasts.com).
This page last updated: Friday, 30 April, 1999

Written in notepad and compiled with WTA, for clean, consistent HTML.
Part of the Casio Graphical Calculator Encyclopaedia.

Best Viewed With Any Browser