Discussion forum about PANORAMIC language

Mac, Windows & Android application development with PANORAMIC language
 
HomeFAQSearchRegisterMemberlistUsergroupsLog in
Latest topics
» Hello world.
by Mon Jun 19, 2017 1:37 am

» Biomorphes de PICKOVER
by Sun Jun 18, 2017 2:33 am

» In less than 10 lines of code
by Fri Jun 16, 2017 5:03 am

» Effect Dopler
by Fri Jun 16, 2017 3:29 am

» SuperEllipse
by Wed Jun 14, 2017 4:01 am

» Plants
by Wed Jun 14, 2017 3:38 am

» Mira's attractor
by Wed Jun 14, 2017 3:30 am

» Triangle of Sierpinski
by Wed Jun 14, 2017 3:22 am

» Esthétique polaire
by Wed Jun 14, 2017 3:16 am

» Butterfly effect : Lorenz equations
by Wed Jun 14, 2017 3:08 am

» Collision detection
by Tue Jun 13, 2017 5:09 am

» The Bees Laline Paull Epub Books
by Mon Oct 10, 2016 8:58 pm

» PANORAMIC for Mac OSX 10 is available
by Tue Aug 09, 2016 6:08 pm

» ide
by Sat Jul 16, 2016 12:27 am

» Can I change the program icon/logo in my application ?
by Thu Jul 07, 2016 3:32 am

Navigation
 Portal
 Index
 Memberlist
 Profile
 FAQ
 Search

Share | 
 

 Samegame clone

View previous topic View next topic Go down 
AuthorMessage
lodchjo



Number of posts : 10
Registration date : 2012-01-30

PostSubject: Samegame clone   Fri May 25, 2012 3:20 pm

Here's my version of the Morisuke's Samegame:
It shows Panoramic is a powerful programming language and games don't require thousands of code to work.
Enjoy it!
Lode



Code:

application_title "SameGame"
label sg, dmn, init, nxt, drw, strt, mm, rst, hlp, xt
width 0,650:height 0,620:color 0,255,255,255:caption 0,"SameGame"
dim m,n,x,y,z, a(21,26), item, sk, k, b(1000),c(1000), a$, d(25), bl, lv, klr, klg, klb, kly, klp, kll, kln, klc, klw
main_menu 2000
sub_menu 2001:parent 2001,2000:caption 2001,"New game":on_click 2001, rst
sub_menu 2002:parent 2002,2000:caption 2002,"Next level":on_click 2002, nxt
sub_menu 2003:parent 2003,2000:caption 2003,"Help":on_click 2003, hlp
sub_menu 2004:parent 2004,2000:caption 2004,"Exit":on_click 2004, xt
form 2010:width 2010, 650:height 2010, 620:caption 2010,"SameGame":color 2010,0,255,0
memo 2011:parent 2011, 2010:left 2011, 5: top 2011, 5:width 2011, 630:height 2011, 495:font_name 2011, "Comic Sans MS": font_size 2011, 12:on_click 2011, mm
alpha 2012:parent 2012, 2010:left 2012, 5: top 2012, 505:width 2012, 300:height 2012, 25: font_size 2012, 12: caption 2012, "ENTER YOUR NAME HERE (12 characters max.):"
color 2012, 0,255,0:font_color 2012, 255,255,255:font_bold 2012
edit 2013:parent 2013, 2010:left 2013, 410: top 2013, 505:width 2013, 225:height 2013, 25: font_size 2013, 12
button 2014:parent 2014, 2010:left 2014, 5: top 2014, 540:width 2014, 630:height 2014, 40: caption 2014, "INITIALISING . . . PLEASE WAIT": on_click 2014, strt
inactive 2014
set_focus 2013
container 2019:top 2019,16:left 2019, 460:width 2019,165: height 2019, 170
alpha 2020:parent 2020, 2019:left 2020,10:top 2020, 20:caption 2020, "Player:":font_bold 2020
alpha 2021:parent 2021, 2019:left 2021,10:top 2021, 50:caption 2021, "Skore:":font_bold 2021
alpha 2022:parent 2022, 2019:left 2022,10:top 2022, 80:caption 2022, "Level:":font_bold 2022
alpha 2023:parent 2023, 2019:left 2023,10:top 2023,110:caption 2023, "Bonus:":font_bold 2023
alpha 2024:parent 2024, 2019:left 2024,10:top 2024,140:caption 2024, "Blocks left:":font_bold 2024
container 2025:top 2025,200:left 2025, 460:width 2025,165
alpha 2026:parent 2026, 2025:left 2026,10:top 2026, 20:font_bold 2026:font_color 2026,255,0,0: rem red
alpha 2027:parent 2027, 2025:left 2027,10:top 2027, 50:font_bold 2027:font_color 2027,0,255,0:rem green
alpha 2028:parent 2028, 2025:left 2028,10:top 2028, 80:font_bold 2028:font_color 2028,0,0,255:rem blue
alpha 2029:parent 2029, 2025:left 2029,10:top 2029, 110:font_bold 2029:font_color 2029,255,255,0:rem yellow
alpha 2030:parent 2030, 2025:left 2030,10:top 2030, 140:font_bold 2030:font_color 2030,255,0,255:rem pink
alpha 2031:parent 2031, 2025:left 2031,10:top 2031, 170:font_bold 2031:font_color 2031,0,255,255:rem light blue
alpha 2032:parent 2032, 2025:left 2032,10:top 2032, 200:font_bold 2032:font_color 2032,200,100,0:rem brown
alpha 2033:parent 2033, 2025:left 2033,10:top 2033, 230:font_bold 2033:font_color 2033,0,0,0:rem black
alpha 2034:parent 2034, 2025:left 2034,10:top 2034, 260:font_bold 2034:color 2034,0,0,0:font_color 2034,255,255,255:rem white
item_add 2011, " "
item_add 2011, string$(26," ")+"Instructions:"
item_add 2011, string$(25," ")+"---------------"
item_add 2011, " "
item_add 2011, "    - The goal of the game is to clear the game field."
item_add 2011, "    - To remove blocks, click on a block."
item_add 2011, "    - Adjoining blocks of the same color will also be removed."
item_add 2011, "    - Think strategically to remove as many blocks as possible."
item_add 2011, "    - The more blocks removed with 1 click, the higher the bonus!"
item_add 2011, "    - Single blocks cannot be removed. The minimum number of blocks is 2."
item_add 2011, "    - When all blocks have been removed, you go to the next level."
item_add 2011, "    - If you cannot remove all blocks, you can still go to the next level,"
item_add 2011, "      but you will lose 100 points for each block left over."
item_add 2011, "      (Press 'next level' in the menu.)"
item_add 2011, "    - If you succesfully removed all blocks, you get a 1.000 bonus!"
item_add 2011, "    - Each next level adds an extra color."
item_add 2011, "    - The game is over when you lose too many points and get a negative score."
item_add 2011, " "
item_add 2011, string$(25," ")+"Programmed by Lodchjo © 2012 using Panoramic Language."
item_add 2011, string$(25," ")+"(Original game by Kuniaki Moribe (Morisuke), 1985.)"
for y = 1 to 25
for x = 1 to 20
 picture x+y*25
 left x+y*25, x*21:height x+y*25, 20: width x+y*25, 20: top x+y*25,y*21:on_click x+y*25,sg
next x
next y
caption 2014, "START  GAME":active 2014
lv=1
sk=0
gosub init
end
init:
bl=500
m=0
klr=0:klg=0:klb=0:kly=0:kll=0:kln=0:klc=0:klw=0:klp=0
caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl)
for y = 1 to 25
for x = 1 to 20
 a(x,y)= int(rnd(lv+2)+1)
 gosub drw
 show x+y*25
next x
next y
caption 2026, str$(int(klr/(lv+4))) + "% red blocks"
caption 2027, str$(int(klg/(lv+4))) + "% green blocks"
caption 2028, str$(int(klb/(lv+4))) + "% blue blocks"
if kly>0 then caption 2029, str$(int(kly/(lv+4))) + "% yellow blocks"
if klp>0 then caption 2030, str$(int(klp/(lv+4))) + "% pink blocks"
if kll>0 then caption 2031, str$(int(kll/(lv+4))) + "% light blue"
if kln>0 then caption 2032, str$(int(kln/(lv+4))) + "% brown"
if klc>0 then caption 2033, str$(int(klc/(lv+4))) + "% black"
if klw>0 then caption 2034, str$(int(klw/(lv+4))) + "% white"
height 2025, 80+lv*30
return
sg:
item = number_click
if number_change>0 then item = number_change
if item>0
 x=mod(item,25)
 y=(item-x)/25
 k=a(x,y)
 if a(x-1,y)<>k and a(x+1,y)<>k and a(x,y+1)<>k and a(x,y-1)<>k then return
 hide item:sk=sk+1:bl=bl-1
 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl)
 a(x,y)=0
 b(1)=x:c(1)=y
end_if
 if k<>0 then gosub dmn
return
dmn:
 n=1
 m=0
 repeat
 n=n-1
 if x>1 and a(x-1,y)=k then n=n+1:m=m+1:b(n)=x-1:c(n)=y:sk=sk+1:bl=bl-1
 if x<20 and a(x+1,y)=k then n=n+1:m=m+1:b(n)=x+1:c(n)=y:sk=sk+1:bl=bl-1
 if y>1 and a(x,y-1)=k then n=n+1:m=m+1:b(n)=x:c(n)=y-1:sk=sk+1:bl=bl-1
 if y<25 and a(x,y+1)=k then n=n+1:m=m+1:b(n)=x:c(n)=y+1:sk=sk+1:bl=bl-1
 for z=1 to n
  hide b(z)+c(z)*25:a(b(z),c(z))=0
 next z
 x=b(n):y=c(n)
 until n=0
 sk=sk+m*(m-1)
 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl)
 wait 50
 if bl=0 then message "Congratulations!! Perfect game!":goto nxt
rem -------------------------- fl=falling blocks
for x = 1 to 20
 for y = 0 to 24
  if a(x,y)<>0 and a(x,y+1)=0 then a(x,y+1)=a(x,y):a(x,y)=0:show (x+(y+1)*25):hide (x+y*25):y=0
 next y
 for y = 1 to 25
  gosub drw
 next y
next x
rem ---------------------------- check for empty columns
z=0
c(1)=0
for x = 1 to 20
 d(x)=0
 for y=1 to 25
  d(x)=d(x)+a(x,y)
 next y
next x
rem ------------------------------ move columns
for x = 1 to 19
 if d(x+1)<>0 and d(x)=0
 d(x)=d(x+1):d(x+1)=0
 for y = 1 to 25
  a(x,y)=a(x+1,y):a(x+1,y)=0:hide (x+1+y*25)
  gosub drw
 next y
 x=1
 end_if
next x
return
nxt:
 if bl>0 then sk = sk-bl*100:message "You lose "+str$(bl*100)+" points!"
 if bl=0 then sk = sk+1000:message "You win 1000 extra points!"
 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(bl*100):caption 2024,"Blocks left: "+str$(bl)
 if sk <0 then message "Game Over":lv=0:sk=0: show 2014
 lv=lv+1:if lv>8 then lv=1
 goto init
return
drw:
  select a(x,y)
  case 0
  hide x+y*25
  case 1
  color x+y*25, 255,0,0:show x+y*25
  if bl=500 then klr=klr+1
  case 2
  color x+y*25, 0,255,0:show x+y*25
  if bl=500 then klg=klg+1
  case 3
  color x+y*25, 0,0,255:show x+y*25
  if bl=500 then klb=klb+1
  case 4
  color x+y*25, 255,255,0:show x+y*25
  if bl=500 then kly=kly+1
  case 5
  color x+y*25, 255,0,255:show x+y*25
  if bl=500 then klp=klp+1
  case 6
  color x+y*25, 0,255,255:show x+y*25
  if bl=500 then kll=kll+1
  case 7
  color x+y*25, 200,100,0:show x+y*25
  if bl=500 then kln=kln+1
  case 8
  color x+y*25, 0,0,0:show x+y*25
  if bl=500 then klc=klc+1
  case 9
  color x+y*25, 255,255,255:show x+y*25
  if bl=500 then klw=klw+1
 end_select
return
strt:
 caption 2020, "Player: "+left$(text$(2013),12)
 hide 2010
return
mm:
 set_focus 2013
return
rst:
 show 2010
 sk=0
 caption 2021,"Score: "+str$(sk):caption 2022, "Level: "+str$(lv):caption 2023,"Bonus: "+str$(m*(m-1)):caption 2024,"Blocks left: "+str$(bl)
 gosub init
return
hlp:
 show 2010
return
xt:
 terminate
Back to top Go down
View user profile
 
Samegame clone
View previous topic View next topic Back to top 
Page 1 of 1
 Similar topics
-
» Who's That Pokemon Clone? It's Little Masters!
» Road Rash Clone, Road Redemption Confirmed For The Wii U Console!
» How to Clone Apps & Run Multi Accounts on Android with CLONEiT

Permissions in this forum:You cannot reply to topics in this forum
Discussion forum about PANORAMIC language :: Panoramic for Windows :: Source code (snippets)-
Jump to: